[[20230614114640]]　『VBA：完全一致する文字列の処理』（真夜中）　ページの最後に飛ぶ

『VBA：完全一致する文字列の処理』（真夜中）

【出力先】
ブックA：印刷用（シート名：フォーマット）

【引用先】
ブックB：契約一覧（シート名：登録用）
ブックC：物件一覧（シート名：物件一覧）

【処理内容】
（１）ブックBのAO列に"●"の入力がある行を探す

（２）BL列同士の比較・・・「完全一致する文字列」があるか探す

（２）ー１　「完全一致する文字列」がない場合
　　（２）ー１－１　BL列の数をカウントする

		（２）ー１－２　カウントした数だけブックＡのシート名：フォーマットを複製する
		（２）ー１－３　ブックBのAO列に"●"の入力がある行の
　					AQ列をブックAのG72に転記
　　					C列をブックAのBC72に転記
　　					BP列をブックAのCG72に転記
　　					BL列をブックAのS67に転記
					※1行目＝シート１に転記、2行目＝シート２に転記・・・最終行までループする
					→転記終了後は（３）の処理に移る

（２）ー２　「完全一致する文字列」がある場合

		（２）ー１－１　（「完全一致していない文字列」の行数）＋（「完全一致する文字列」の行数はまとめて１とカウント）→BL列のこの数をカウントする
		（２）ー１－２　カウントした数だけブックＡのシート名：フォーマットを複製する
		（２）ー１－３　「完全一致していない文字列」の行は、（２）ー１－３と同様に処理を行う
				「完全一致する文字列」の行は、同じシート内に転記を行う
　			　		　AQ列をブックAのG72、G73、G74・・・に転記
　　			　　		　C列をブックAのBC72、BC73、BC74・・・に転記
　			　　		　BP列をブックAのCG72、CG73、CG74・・・に転記
　			　　		　BL列をブックAのS67に転記
					→転記終了後は（３）の処理に移る

（３）ブックAのS67とブックCのC列を比較し一致している行の情報を転記する
　　　また、一致しているブックCの行に赤色で色を付ける
　ブックCのF列をブックAのH55に転記
　ブックCのH列をブックAのBH55に転記
　ブックCのJ列をブックAのAM60に転記
　ブックCのK列をブックAのH62に転記
　ブックCのL列をブックAのQ61に転記

（４）ブックA＝閉じない　ブックB＝閉じる、ブックC＝閉じない
（５）終了

Sub CopyDataAndFormat()

    Dim wbA As Workbook, wbB As Workbook, wbC As Workbook
    Dim printSheet As Worksheet, dataSheetB As Worksheet, dataSheetC As Worksheet

    ' ブックを開く
    Set wbA = Workbooks.Open("※※※\印刷用.xlsm")
    Set wbB = Workbooks.Open("※※※\契約一覧.xlsx")
    Set dataSheetB = wbB.Worksheets("登録用")
    Set wbC = Workbooks.Open("※※※\物件一覧.xlsx")
    Set dataSheetC = wbC.Worksheets("物件一覧")

    ' ブックBのAO列に"●"の入力がある行を取得
    Dim lastRowB As Long
    lastRowB = dataSheetB.Cells(dataSheetB.Rows.count, "AO").End(xlUp).Row

    ' ブックAのシート名: フォーマットを複製
    Dim i As Long
    Dim sheetIndex As Long
    sheetIndex = 1

    For i = 1 To lastRowB
        If dataSheetB.Range("AO" & i).value = "●" Then
            If dataSheetB.Range("BL" & i).value = dataSheetB.Range("BL" & i - 1).value Then
                ' 同じシートに転記
                Set printSheet = wbA.Sheets("フォーマット" & sheetIndex)
            Else
                ' 新しいシートを複製
                wbA.Sheets("フォーマット").Copy After:=wbA.Sheets(wbA.Sheets.count)
                Set printSheet = wbA.Sheets(wbA.Sheets.count)
                sheetIndex = sheetIndex + 1
            End If

            ' 転記処理
            printSheet.Range("G72").value = dataSheetB.Range("AQ" & i).value
            printSheet.Range("BC72").value = dataSheetB.Range("C" & i).value
            printSheet.Range("CG72").value = dataSheetB.Range("BP" & i).value
            printSheet.Range("S67").value = dataSheetB.Range("BL" & i).value

            ' ブックCとの比較・転記処理
            Dim searchValue As Variant
            searchValue = printSheet.Range("S67").value

            Dim matchCell As Range
            Set matchCell = dataSheetC.Columns("C").Find(searchValue, LookIn:=xlValues, LookAt:=xlWhole)

            If Not matchCell Is Nothing Then
                printSheet.Range("H55").value = dataSheetC.Range("F" & matchCell.Row).value
                printSheet.Range("BH55").value = dataSheetC.Range("H" & matchCell.Row).value
                printSheet.Range("AM60").value = dataSheetC.Range("J" & matchCell.Row).value
                printSheet.Range("H62").value = dataSheetC.Range("K" & matchCell.Row).value
                printSheet.Range("Q61").value = dataSheetC.Range("L" & matchCell.Row).value

                ' ブックCのC列のセルに赤色を設定
                dataSheetC.Range("C" & matchCell.Row).Interior.Color = RGB(255, 0, 0)
            End If
        End If
    Next i

    ' ブックA
    wbA.Save

    ' ブックB
    wbB.Save
    wbB.Close

    ' ブックC
    wbC.Save

End Sub

上記コードだと、（２）ー２の処理がうまくいきません。
それ以外はやりたいように動きます。
当方VBAコード初心者です。
見よう見まねでここまで書いてみましたが、どなたか修正コードを教えてください。
よろしくお願いいたします。

＜使用 Excel：Microsoft365、使用 OS：Windows10 ＞

 簡単なサンプルデータを示して説明してください。

 また、うまくいかないとは具体的にどういうことですか？
 エラーになるなら、どの行で発生して、エラーメッセージは何ですか？

 想定と異なる結果になるなら、
 ・想定はどういうことで
 ・しかし、実際はこうなってしまう
 という説明をしてください。

 こういう説明があれば、回答も寄せられるでしょうし、回答者の負担が軽減されると思います。

（xyz） 2023/06/14(水) 12:14:47

うまくいかないという曖昧な表現を使ってしまいすみませんでした。
正しくは、（２）ー２の処理がされません。スルーされてしまいます。
それ以外の処理はうまくできています。

（真夜中） 2023/06/14(水) 13:45:44

ブックB　AO列　BL列：商品名

	　●	りんご
		ばなな
	　●	いちご
	　●	みかん
	　●	ぶどう
		すいか
	　●	ぶどう
		ぶどう

（２）ー２の処理
　　　（１）でAO列に"●"がある行を探す（りんご、いちご、みかん、ぶどう、ぶどうの5行）
　　　（２）BL列「商品名」列に重複がある場合→りんご・いちご・みかんの３つ＋ぶどうの１つで4枚シートを複製する
　　　　　　複製後、シート１にりんごの各情報を転記、いちご・みかんも同様に処理、ぶどうの情報はシート４にまとめて転記する

（真夜中） 2023/06/14(水) 14:00:14

 ＞If dataSheetB.Range("BL" & i).value = dataSheetB.Range("BL" & i - 1).value Then
 だと、前の一つの行とだけ比較してますよね。
 それでいいんですか？
 それでいいように●がついているのだったらいいですけど、
 そういう説明が無いので分かりかねます。

（xyz） 2023/06/14(水) 16:23:00

xyzさん
コメントありがとうございます。
シート全体は2万行くらいあり、その中でAO列に10個前後●が付きます。
この●がついている行の、BL列全行を比較対象としたいのですが、
どのようにコード修正すればよいでしょうか。。
（真夜中） 2023/06/14(水) 16:36:08

 | (2)-1 「完全一致する文字列」がない場合
 |         (2)-1-1 BL列の数をカウントする
 |         (2)-1-2 カウントした数だけブックAのシ-ト名:フォ-マットを複製する
 |         (2)-1-3 ブックBのAO列に"●"の入力がある行の
 |                     AQ列をブックAのG 72に転記
 |                     C列 をブックAのBC72に転記
 |                     BP列をブックAのCG72に転記
 |                     BL列をブックAのS 67に転記
 |                     ※1行目=シ-ト1に転記、2行目=シ-ト2に転記・・・最終行までル-プする
 |                     →転記終了後は(3)の処理に移る

 | 「完全一致する文字列」がない場合
 AO列が"●"である行のBL列文字列が、そのBL列には唯一しかない場合は、
 その行だけの情報をもとに転記するんですね？
 これはわかります。
 （(2)-1-1 BL列の数をカウントする、とのことですが 1 ではないんですか？
   そういうケースと決まっているんでしょう？）

 | (2)-2 「完全一致する文字列」がある場合
 | 
 |         (2)-1-1  (「完全一致していない文字列」の行数)
 |                 +(「完全一致する文字列」の行数はまとめて1とカウント)
 |                 → BL列のこの数をカウントする
 |         (2)-1-2  カウントした数だけブックAのシ-ト名:フォ-マット を複製する
 |         (2)-1-3 「完全一致していない文字列」の行は、(2)-1-3と同様に処理を行う
 |                 「完全一致する文字列」の行は、同じシ-ト内に転記を行う
 |                      AQ列をブックAのG72、G73、G74・・・に転記
 |                      C列をブックA のBC72、BC73、BC74・・・に転記
 |                      BP列をブックAのCG72、CG73、CG74・・・に転記
 |                      BL列をブックAのS67に転記
 |                     →転記終了後は(3)の処理に移る

 こちらがさっぱり分かりません。

 大雑把に一言で言うとどういうことなんですか？
 BL列に2個以上の同じ文字列があるんですよね。
 そのとき、どうするんですか？

 (2)-1 では、一行しかないデータをもとに転記するんでしたね。
 ある意味で単純です。

 (2)-２ は 
 「完全一致していない文字列」の行も転記するんですか？
 転記内容がさっぱり分かりません。

 ・(2)-1-1の意味内容、
 また、
 |  (2)-1-3 「完全一致していない文字列」の行は、(2)-1-3と同様に処理を行う
 も他人にわかるように説明してください。
 そうすれば、コメントがつくかもしれません。

 私の能力を超えるので、ここまでとさせていただきます。御免なさい。
（xyz） 2023/06/14(水) 19:57:20

 同一の文字列の個数を調べるには、ワークシート関数のCOUNTIFとかCOUNTIFSとかが使えます。
 頭にWorksheetFunction.を付けるとよいでしょう。
 ご自分でロジックがしっかりできているなら、このヒントで解決できるのではないですか？
 そんな気がしてきました。頑張ってください。

（xyz） 2023/06/14(水) 20:05:18

コメント返信：

[ 一覧(最新更新順) ]

[[20230614114640]] 『VBA：完全一致する文字列の処理』（真夜中） ページの最後に飛ぶ

[[20230614114640]]　『VBA：完全一致する文字列の処理』（真夜中）　ページの最後に飛ぶ