[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『VBA 特定の文字がある行を別のシートへ移動』（祈）
こんばんは。ご質問させていただきます。
特定の文字"-"のある行をSheet1からShee2にコピーして、Sheet1から消して行を詰めるというマクロを作っています。
このマクロは、ネット上に出ていたものを参照させていただいています。
Sheet1のB列からS列までの5行目以下にデータが入っています。
B列に特定の文字"-"が入っている場合、C列からS列までをコピーさせ、Sheet1から消したいのです。
ところが、どうしても結果は、B列からJ列がコピーされてしまい、思うような結果を出せません。
どのような修正が必要でしょうか。よろしくお願いいたします。
Sub hyphen()
nMax2 = Sheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Row + 1
With Sheets("Sheet1")
nMax1 = .Cells(Rows.Count, 2).End(xlUp).Row
For i = nMax1 To 1 Step -1
If .Cells(i, 2) = "-" Then
.Range(.Cells(i, 1), .Cells(i, 19)).Copy
Sheets("Sheet2").Cells(nMax2, 1).Insert Shift:=xlDown
.Range(.Cells(i, 1), .Cells(i, 19)).Delete Shift:=xlUp
End If
Next i
End With
End Sub
＜ 使用 Excel：Office365、使用 OS：Windows10 ＞
With Sheets("Sheet1")
.Range(.Cells(i, 1), .Cells(i, 19)).Copy
なので、A〜S列がコピーされそうな気がするですが・・・
（もこな２ ） 2020/05/20(水) 23:16
やはり、↓で試してみるとA〜S列なんですよねぇ・・・
Sub aaa()
Dim i As Long
With Worksheets("Sheet1")
For i = 1 To 5
MsgBox .Range(.Cells(i, 1), .Cells(i, 19)).Address(False, False)
Next i
End With
End Sub
（もこな２ ） 2020/05/21(木) 00:38
補足でお伝えしているのですが、
このSheet1の行を減らさずに(100行設定していたら、移動後もそのまま)、しかもA列からではなく、C列からS列をコピーさせたいのです。
（祈） 2020/05/21(木) 05:28
あとは、Sheet1の行を減らさない設定方法です。
（祈） 2020/05/21(木) 05:54
ちなみに、あえて列文字を使うとか
.Range(.Cells(i, "C"), .Cells(i, "S")).Copy
ちょっと混乱するかもしれませんが、Intersectメソッドを使うとか
Intersect(.Rows(i), .Range("C:S")).Copy
↓のように、表のなかの行ごとに処理しちゃうとか
Sub hyphen_改()
nMax2 = Sheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Row + 1
With Sheets("Sheet1")
nMax1 = .Cells(Rows.Count, 2).End(xlUp).Row
With .Range("C1", .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, "S"))
For i = .Rows.Count To 1 Step -1
.Rows(i).Copy
Sheets("Sheet2").Cells(nMax2, "A").Insert Shift:=xlDown
Next i
End With
End With
End Sub
いろいろなアプローチがあるとおもいます。
（いったん区切ります）
（もこな２ ） 2020/05/21(木) 07:08
Sub 別案()
Dim MyRNG As Range
Dim i As Long
Dim dstRNG As Range
Dim nMax1 As Long
'▼出力先セルの取得
With Worksheets("Sheet2")
Set dstRNG = .Cells(.Rows.Count, "B").End(xlUp).Offset(1, -1)
End With
'▼作業用のシートを作成
Worksheets("Sheet1").Copy after:=Worksheets(Worksheets.Count)
'▼作業用シートで作業
With Worksheets(Worksheets.Count)
nMax1 = .Cells(Rows.Count, "B").End(xlUp).Row
For i = nMax1 To 1 Step -1
If .Cells(i, "B") = "-" Then
.Range(.Cells(i, "C"), .Cells(i, "S")).Copy
dstRNG.Insert Shift:=xlDown
.Range(.Cells(i, "C"), .Cells(i, "S")).Delete Shift:=xlUp
End If
Next i
'作業用シートの内容を"Sheet1"に値のみ貼り付けして、作業用シートは削除
.Range("C1:S" & nMax1).Copy
Worksheets("Sheet1").Range("C1").PasteSpecial Paste:=xlPasteValues
.Delete
End With
End Sub
（もこな２ ） 2020/05/21(木) 07:35
参考 https://excelwork.info/excel/cutcopymode/ https://www.moug.net/tech/exvba/0150081.html https://excel-ubara.com/excelvba1/EXCELVBA327.html
（もこな２） 2020/05/21(木) 08:38
.Range(.Cells(i, 2), .Cells(i, 19)).Copy
Sheets("Sheet2").Cells(nMax2, 2).Insert Shift:=xlDown
.Range(.Cells(i, 3), .Cells(i, 19)).ClearContents
（祈） 2020/05/21(木) 21:56
（γ） 2020/05/21(木) 22:18
.Range(.Cells(i, 2), .Cells(i, 19)).Copy
Sheets("Sheet2").Cells(nMax2, 2).Insert Shift:=xlDown
.Range(.Cells(i, 3), .Cells(i, 19)).ClearContents
Call Range("B5:S204").Sort(Key1:=Range("B5"), Order1:=xlDescending)
（祈） 2020/05/21(木) 22:31
（γ） 2020/05/21(木) 22:47
Sub hyphen()
'Sheet2の挿入位置(C列は結合セルではなく、必ず何か入っている事）
nMax2 = Sheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Row + 1
With Sheets("Sheet1")
nMax1 = .Cells(Rows.Count, 2).End(xlUp).Row
For i = nMax1 To 1 Step -1
If .Cells(i, 2) = "-" Then
'C〜S列を移動対象とする
.Range(.Cells(i, 2), .Cells(i, 19)).Copy
Sheets("Sheet2").Cells(nMax2, 2).Insert Shift:=xlDown
.Range(.Cells(i, 3), .Cells(i, 19)).ClearContents
Call Range("B5:S204").Sort(Key1:=Range("B5"), Order1:=xlAscending)
End If
Next i
End With
End Sub
（祈） 2020/05/21(木) 22:50
シートの指定をすれば、以下でよいでしょうか？
Sheets("Sheet1").Call Range("B5:S204").Sort(Key1:=Range("B5"), Order1:=xlAscending)
（祈） 2020/05/21(木) 23:10
オブジェクトは、このプロパティまたはメソッドをサポートしていません。
（祈） 2020/05/21(木) 23:26
＞Sheets("Sheet1").Call Range("B5:S204").Sort(Key1:=Range("B5"), Order1:=xlAscending)
ワークシートオブジェクトはCallなどというメソッドもプロパティも持ちませんが、
どのような意図を持って、このコードを書かれましたか？
（γ） 2020/05/21(木) 23:35
マクロでクリアされた行を特定して、最終行にカット＆インサートによる疑似並び替えができないかなと思ってます。
（もこな２） 2020/05/21(木) 23:40
γさん、
以下を参照しました。が、わたしの理解不足かと思います。
https://www.tipsfound.com/vba/07032
（祈） 2020/05/21(木) 23:48
たとえば、For i = nMax1 To 1 Step -1の繰り返しのなかで、
どこかの列(例えばT列）に、i を順次書き込んで置いて、
条件が満たされたときに、S列までを拡大してT列まで消去し、
（.Range(.Cells(i, 3), .Cells(i, 20)).ClearContents とT列も消去します。)
その繰り返しが終了したあとで、
T列を元にしてソートをすれば、T列が空白になっている行は、最後に追いやられると思います。
最後に T列を ClearContents します。
（γ） 2020/05/22(金) 00:14
Sheets("Sheet1").Range("B5:S204").Sort(Key1:=Range("B5"), Order1:=xlAscending)
（祈） 2020/05/22(金) 05:02
しかし、特定の文字が1行だけの場合は、希望どおりにSheet2にコピーして、Sheet1からクリアして、並び替えてくれたのですが、2行以上になると1行だけがSheet2にコピーされ、その他行は範囲の一番下に並び替えられてしまい、Sheet2にもコピーされません。実行のボタンを何度も押すと、コピーされました。
この結果を見て、γさんがおっしゃることがわかるように思いました。
これをどう修正していくかですが、やはり並び替えの命令がうまくできていないのですよね。
（祈） 2020/05/22(金) 07:04
＞実行のボタンを何度も押すと、
繰り返しになりますが、ステップ実行されてますか？
１つずつ動き動きをチェックして、想定通りになっていなければ原因を分析して直す。これも大事なデバッグ作業の一つですよ。
（もこな２ ） 2020/05/22(金) 08:41
γさんのアイデアで、T列じゃなくZ列を作業列にした場合
Sub hyphen()
Dim nMax2,nMax1,i
nMax2 = Sheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Row + 1
With Sheets("Sheet1")
.Range("Z1:Z204").ClearContents 'Z列を事前にクリア
nMax1 = .Cells(Rows.Count, 2).End(xlUp).Row
For i = nMax1 To 5 Step -1 '5行目まで遡る
If .Cells(i, 2) = "-" Then
.Range(.Cells(i, "C"), .Cells(i, "S")).Copy
Sheets("Sheet2").Cells(nMax2, 1).Insert Shift:=xlDown
.Range(.Cells(i, "C"), .Cells(i, "Z")).ClearContents
Else
.Cells(i, "Z") = i
End If
Next i
.Range("B5:Z204").Sort Key1:=.Range("Z5"), Order1:=xlAscending
.Range("Z1:Z204").ClearContents 'Z列を後始末
End With
End Sub
（半平太） 2020/05/22(金) 09:17
（祈） 2020/05/23(土) 08:02
（もこな２ ） 2020/05/23(土) 08:23
とおもいましたが、パスワード部分は記録されないかもしれません。
http://officetanaka.net/excel/vba/sheet/sheet07.htm
その場合は↑が参考になると思います。 8 :36追記
Sub hyphen()
Dim nMax2, nMax1, i
nMax2 = Sheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Row + 1
With Sheets("Sheet1")
.Range("U1:U204").ClearContents 'U列を事前にクリア
nMax1 = .Cells(Rows.Count, 2).End(xlUp).Row
For i = nMax1 To 5 Step -1 '5行目まで遡る
If .Cells(i, 2) = "-" Then
.Range(.Cells(i, "B"), .Cells(i, "S")).Copy
Sheets("Sheet2").Cells(nMax2, 2).Insert Shift:=xlDown
.Range(.Cells(i, "C"), .Cells(i, "U")).ClearContents
Else
.Cells(i, "U") = i
End If
Next i
.Range("B5:U204").Sort Key1:=.Range("U5"), Order1:=xlAscending
.Range("U1:U204").ClearContents 'U列を後始末
End With
→ Sheets("Sheet1").Unprotect "11100"
→ Sheets("Sheet1").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
→ Sheets("Sheet1").ReProtect "11100"
End Sub
（祈） 2020/05/23(土) 17:37
ちなみに、提示されたコードで「ReProtect」とありますが、どんな命令なんですか？
（私の環境だと、エラーコード 439：オブジェクトは、このプロパティまたはメソッドをサポートしてません。となります）
また、順当にいけば、
【シートの操作を始める前（マクロ開始直後】に保護解除をして
具体的な操作をした後に
【終了直前で】保護をするんじゃないでしょうか？
（なんで最後に解除して、すぐ保護するんですか？）
（もこな２ ） 2020/05/23(土) 18:16
＞マクロ開始直後に解除→マクロ終了直前で保護したいのです。
では、そのような順番で書くべきですよね。なんでそうしないのですか？
（もこな２ ） 2020/05/24(日) 11:39
→ Sheets("Sheet1").Unprotect "11100"
→ Sheets("Sheet1").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
（祈） 2020/05/24(日) 23:24
パスワードをかけて保護をかけた状態からマクロを実行しようとすると、エラー400が表示され、マクロが実行されません。
（祈） 2020/05/24(日) 23:39
とりあえず、名前付き引数を省略せずに書くようにしたらどうでしょうか？
Sub さんぷるA()
'シート保護を解除する命令
Worksheets("Sheet1").Unprotect Password:="11100"
'■処理■
'シート保護をする命令
Worksheets("Sheet1").Protect Password:="11100"
End Sub
ちなみに、紹介したリンク先を読めばわかるとおもいますが↓でもよいとおもいます。
Sub さんぷるB()
'シート保護を解除する命令
Worksheets("Sheet1").Unprotect Password:="11100"
'UserInterfaceOnly:=Trueにして、シート保護をする命令
Worksheets("Sheet1").Protect Password:="11100", UserInterfaceOnly:=True
'■処理■
End Sub
（もこな２ ） 2020/05/25(月) 02:30
Sub hyphen()
Dim nMax2, nMax1, i
nMax2 = Sheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Row + 1
With Sheets("Sheet1")
.Range("U1:U204").ClearContents 'U列を事前にクリア
nMax1 = .Cells(Rows.Count, 2).End(xlUp).Row
For i = nMax1 To 5 Step -1 '5行目まで遡る
If .Cells(i, 2) = "-" Then
.Range(.Cells(i, "B"), .Cells(i, "S")).Copy
Sheets("Sheet2").Cells(nMax2, 2).Insert Shift:=xlDown
.Range(.Cells(i, "C"), .Cells(i, "U")).ClearContents
Else
.Cells(i, "U") = i
End If
Next i
.Range("B5:U204").Sort Key1:=.Range("U5"), Order1:=xlAscending
.Range("U1:U204").ClearContents 'U列を後始末
End With
Worksheets("Sheet1").Unprotect Password:="11100"
Worksheets("Sheet1").Protect Password:="11100", UserInterfaceOnly:=True
Worksheets("Sheet2").Unprotect Password:="11100"
Worksheets("Sheet2").Protect Password:="11100", UserInterfaceOnly:=True
End Sub
（祈） 2020/05/25(月) 07:19
横から失礼、2点コメントします。 (1) 最後に保護解除と保護設定する意図がよくわかりません。 (2) UserInterfaceOnly:=True について誤解があるようです。
「UserInterfaceOnly:=True」の有効期間はそのワークブックを閉じるまでです。 ですから、次回にそれを開いたときには、UserInterfaceOnlyはFalseになっています。 したがって、今のコード（マクロでワークシートを変更）を実行すると、ワークシートが保護 されているのでエラーになるはずです。
ブックを開いた時に、UserInterfaceOnly:=Trueを再設定する必要があります。 このため、Workbook_Openプロシージャの中で設定するのがよいでしょう。
（γ） 2020/05/25(月) 08:16
また、γさんの(2)については、私も同意見（ブックを開いたときに、１回だけ保護しなおす）ではありますが、言われていることが理解できなければ「さんぷるB」のように、毎回実行してもよいと思います。
ちなみに、紹介したリンク先に↓のように書いてあったんですが、読みましたか？
なお注意しなければいけないのは、引数UserInterfaceOnlyにTrueを指定して保護したワークシートをそのまま保存して閉じた場合です。次にそのブックを開いたときには、ユーザーの手動操作だけでなくマクロによる操作も保護されています。
マクロ操作だけを保護の対象からはずすには、再度引数UserInterfaceOnlyにTrueを指定してProtectメソッドを実行しなければなりません。
どうも、「Call」「ReProtect」という謎のプロパティなりメソッドを書くところを見るとちゃんと読んでないんじゃないかと思えてくるんですが・・・・
（もこな２ ） 2020/05/25(月) 09:36
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.