
B列に「両方」が入っている時、その「両方」を含む内容を下に複製し、複製した方のA列の末尾に「A」を追加したいです。
下記に示す内容のVBAを作成しましたが、添付する図のように内容が一か所しか複製されないのです。
どこを修正すれば良いでしょうか。
よろしくお願いいたします。
Sub 両方が入っている場合に下に複製()
Dim tgt As Long
Dim tgtmax As Long
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
tgtmax = ws1.Cells(Rows.Count, "A").End(xlUp).Row 'tgtデータの最終行
'両方の場合の複製
For tgt = 2 To tgtmax
If ws1.Range("B" & tgt).Value = "両方" Then
Application.Goto Reference:=ws1.Range("A" & tgt), Scroll:=True
Application.ScreenUpdating = False
'// 現在行位置を取得
iRow = Selection.Row
'// 選択行数を取得
iRowCount = Selection.Rows.Count
If (iRowCount = 1) Then
iRowCount = 0
ElseIf (iRowCount > 1) Then
iRowCount = iRowCount - 2
End If
'// 選択セルの先頭行を選択
Range(iRow & ":" & iRow).Select
'// 選択行をコピー
Selection.Copy
'// 行数分だけ選択
Range(iRow + 1 & ":" & iRow + 1 + iRowCount).Select
'// 行数分貼り付け
Selection.Insert Shift:=xlDown
Range("A" & iRow + 1 + iRowCount).Select
Selection.Value = Selection.Value & "A" '複製した文字列の末尾に「A」を追加
Application.ScreenUpdating = True
Exit For
End If
Next
End Sub

No.3ベストアンサー
- 回答日時:
#1ですが
iRowCount = Selection.Rows.Count が気になって考えてみましたが
添付図ではありませんが、、結合セルがあると言う事でしょうか・・
結合セルがある場合、
逆からループすると、どうも計算が合わないような気がします。
しかし、行の挿入や削除のループは、末行から逆にループするのが鉄則です
上から廻す場合は、一旦配列などに入れ出力する方法になります。(これが理想ですが)
.Selectなどを使用している所から、少し難しい事になりそうですね。
ご質問のコードを基に(基本的に.Selectなどをそのままでループもカウント変数を使う方法を維持)
対象セルの結合セルに対応したコードサンプルを検証してみてください
コメントを自身で書き加えると理解できると思います
結合セル在っても無くても大丈夫です
Sub 両方が入っている場合に下に複製()
Dim tgt As Long
Dim tgtmax As Long
Dim iRowCount As Long
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
'tgtデータの最終行
tgtmax = ws1.Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
'行末からループ
For tgt = tgtmax To 2 Step -1
'両方の場合の複製
If ws1.Range("B" & tgt).Value = "両方" Then
'実験用ステップ実行でスクロールすると見にくいので Scroll:=False
Application.Goto Reference:=ws1.Range("A" & tgt), Scroll:=False
'選択セルを含む行 .EntireRow
Selection.EntireRow.Copy
'選択行数 通常:1結合時:結合行数
iRowCount = Selection.Rows.Count
Range(tgt + iRowCount & ":" & tgt + iRowCount).Insert Shift:=xlDown
Application.CutCopyMode = False 'コピー範囲を消す
'変更 対象セルの1つ下に挿入 (結合時:結合行数)
Range("A" & tgt + iRowCount).Select
'複製した文字列の末尾に「A」を追加’変更 結合セルの値が表示されているセル Selection(1)
Selection(1).Value = Selection(1).Value & "A"
End If
Next
Application.ScreenUpdating = True
End Sub
このままだと読みにくいのでVBEで確認してください
回答いただきありがとうございました。
「行の挿入や削除のループは、末行から逆にループするのが鉄則です」←大変参考になりました。
教えていただいたコードで行いたい事ができました。
誠にありがとうございました。
No.2
- 回答日時:
こんばんは。
詳しく見ていませんが、
For tgt = 2 To tgtmax
上から処理して、行が増えるとズレると思いますので、下から処理したら
どうでしょうか?
For tgt = tgtmax To 2 Step -1 で下から2行までの処理になるかと。
回答いただきありがとうございました。
「For tgt = tgtmax To 2 Step -1」という処理は思いつきませんでしたので、大変参考になりました。
No.1
- 回答日時:
こんばんは
流し読みで試していないのですけれど
行を挿入するような感じなので
For tgt = 2 To tgtmax は
For tgt = tgtmax To 2 Step -1 として下からループしてみてください
あと、Exit For は If ws1.Range("B" & tgt).Value = "両方" Then が
True だと 1度処理して ループを抜けてしまいますので
おそらく要りません。
なんか、結合セルも対象になっているような感じですが、良いかな?
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
このQ&Aを見た人はこんなQ&Aも見ています
-
プロが教えるわが家の防犯対策術!
ホームセキュリティのプロが、家庭の防犯対策を真剣に考える 2組のご夫婦へ実際の防犯対策術をご紹介!どうすれば家と家族を守れるのかを教えます!
-
【VBA】特定の文字が入っている行の一部を抽出して別シートコピーするには
Visual Basic(VBA)
-
特定の文字を条件に行挿入とそこからセルデータを追加するVBAについて
Visual Basic(VBA)
-
【VBA】特定の値が入った行をコピーして別シートに貼り付ける方法をおしえていただきたいです。
Excel(エクセル)
-
-
4
特定文字のある行の前に空白行を挿入したい
その他(Microsoft Office)
-
5
もしセルが#N/A"なら~をする・・・には?"
Excel(エクセル)
-
6
特定の条件の時に行を挿入したい
Excel(エクセル)
-
7
【Excel VBA】複数ある特定の文字列を含む行を削除
Excel(エクセル)
-
8
同じ作業を複数のシートに実行させるにはどうしたらいいのでしょうか
Visual Basic(VBA)
-
9
シート名の一部を変更する方法について
Visual Basic(VBA)
-
10
エクセルVBA、特定条件で行を追加
Visual Basic(VBA)
-
11
VBA データ(特定値)のある最終行を取得したい
Excel(エクセル)
-
12
VBAで特定の文字が入力されたセルを選択
Excel(エクセル)
-
13
【VBA】特定列に文字が入っていたらそのセル行をコピーしてマスターブックの同じ行に貼り付けたい
その他(Microsoft Office)
-
14
VBAで条件が一致する行をコピーしその1つ下へ挿入
Excel(エクセル)
-
15
【VBA】指定した検索条件に一致したら別シートに転記したい
Visual Basic(VBA)
-
16
マクロを特定の複数シートで実行する方法
Excel(エクセル)
-
17
【EXCEL】【VBA】空欄は飛ばして処理する方法を教えて下さい。
Excel(エクセル)
-
18
エクセルVBAで5行目からオートフィルタモードに設定したいたい
Excel(エクセル)
-
19
Excelマクロ シート名を変数で選択
Excel(エクセル)
-
20
VBAで、セル(Range)のオブジェクトが取得できない
Excel(エクセル)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
VBSの処理中一旦処理を止めて再...
-
ACCESS側からEXCELの書式を設定...
-
エクセルが勝手に立ち上がる
-
VCでウエイトをミリ秒でかけ...
-
VBSで応答不要のメッセージボッ...
-
SendMessage中のメッセージ・ル...
-
MFCのメニューバーのイベント取得
-
フォルダ指定
-
メッセージボックスのボタン名変更
-
VBA メッセージボックスを自動...
-
【C#】 あるイベントから別イ...
-
Timerのカウントダウンのしかた...
-
メッセージBOXの「はい」「いい...
-
winsock2 非同期処理について
-
VBA kernel32 の意味
-
手動かプログラムでの起動かの判断
-
ファンクションキーのキャンセ...
-
VB.NETのUsingキーワードの使い方
-
ASP.NETでのメッセージ画面を出...
-
マウスのクリックを無視したい
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
beforecloseの中からの抜け出し方
-
VBSの処理中一旦処理を止めて再...
-
VBSで応答不要のメッセージボッ...
-
ACCESS側からEXCELの書式を設定...
-
メッセージボックスのボタン名変更
-
Application.ScreenUpdating=Fa...
-
ASP.NETでのメッセージ画面を出...
-
【C#】 あるイベントから別イ...
-
VBA kernel32 の意味
-
VBA メッセージボックスを自動...
-
VBA、UserFormを前面に出力して...
-
「キャンセル」ボタン付きの処...
-
VBスクリプトで「お待ち下さい...
-
<input type="file">タグで「キ...
-
起動後直に実行するコードはど...
-
マウスのクリックを無視したい
-
MFCのワーカースレッドとUIスレ...
-
Excel VBA で処理中断(DoEvents...
-
ボタンが押された事を検知する...
-
アクセスでのキー送信について
おすすめ情報