この業務をExcel VBAでどう組めばよいですか

質問

ご覧頂きありがとうございます。

現在アビバでExcel VBAを学んでいますが、多少はコードが読めたり弄ったりできるようになりましたが、1からロジックを組んで書き上げる事はまだ到底できそうにありません。。。

添付の画像を基に
下記の作業をどなたか回答例を書いて頂けませんか><
お願いします！

----------------------------
1. (1).xlsmのA3セルの値が(2).xlsmのA列に無いか
上から順番に調べ、”最初に合致した箇所”を調べる

→合致する値がある時
・それぞれのB列（チェック）に 〇 を記入
・(1).xlsmと(2).xlsmのSheet2に、それぞれ 〇 を記入した”行すべて”の値を張り付ける

→合致する値がない時
・次の行へ移動する（(1).xlsmのA3→A4）

2. 順番1. をA列の一番下の行までデータがなくなるまで繰り返す

3. (1).xlsmと(2).xlsmのSheet3に、それぞれ 〇 が記入されていない”行すべて”の値を張り付ける

(サンプル)
(1).xlsm
A品番
395011500033920
220680700001422
241670200000110
348646464554646
395011500033920
167311400021200

(2).xlsm
B品番
167311400021200
395011500033920
220680700001422
241670200000110
167311400021200
241670200000110

----------------------------

分かりづらいところがあれば補足いたします、
お力添えください＞＜

回答No.3

Mathmi · ベストアンサー

軽くコードを組んでみました。
・比較する2つのブックのみを開いた状態で実行する。
　値は双方のブックに出力される。
・(2).xlsmのSheet1のチェックは、途中で合致する値があったとしても最後まで比較する。
　合致した時点でチェックを切り上げる場合は、CompareArrayプロシージャのコメントアウトを外す事。
・レイアウトが関係している場所には※を付けているので、適宜変更の事。

Private Type Config
　'プロシージャ間で持ち回る値を格納
　Book As Workbook
　aryNum() As String '比較する値。
　aryFlg() As Boolean '合致する値かどうか
End Type

Sub CompareBooks()
'ttps://okwave.jp/qa/q9719657.html
　Dim i As Long
　Dim Conf() As Config
　ReDim Conf(1 To 2)

　'ブックを取得。
　Set Conf(1).Book = ThisWorkbook
　Set Conf(2).Book = GetOtherBook

　'比較する値を取得。
　For i = 1 To UBound(Conf)
　　Conf(i).aryNum = GetAryNum(Conf(i).Book.Worksheets("Sheet1"))
　Next i

　'値を比較。
　Call CompareArray(Conf)

　'結果を出力。
　For i = 1 To UBound(Conf)
　　Call OutputData(Conf(i))
　Next i

End Sub

Private Function GetOtherBook() As Workbook
'既に開いている自身以外のBookを返す。
　Dim myBk As Workbook
　'エラーチェック
　If Workbooks.Count <> 2 Then
　　MsgBox "開いているブック数が2個ではありません。"
　　End
　End If

　For Each myBk In Workbooks
　　If Not myBk Is ThisWorkbook Then
　　　Set GetOtherBook = myBk
　　　Exit Function
　　End If
　Next myBk
End Function

Private Function GetAryNum(TargetSheet As Worksheet) As String()
'対象のブックのA3からA列の最終行までの値を配列に格納。
　Dim i As Long
　Dim LastRow As Long
　Dim RtnAry() As String

　'最終行を求め、その範囲の値を配列に格納して返す。
　LastRow = TargetSheet.Cells(TargetSheet.Rows.Count, 1).End(xlUp).Row '※
　ReDim RtnAry(1 To LastRow - 2) '※
　For i = 3 To LastRow '※
　　RtnAry(i - 2) = TargetSheet.Cells(i, 1).Value '※
　Next i
　GetAryNum = RtnAry
End Function

Private Sub CompareArray(Conf() As Config)
'合致する値があるかどうか、2つの配列を比較する。
　Dim i As Long, j As Long

　'配列の要素数を設定
　For i = 1 To UBound(Conf)
　　ReDim Conf(i).aryFlg(1 To UBound(Conf(i).aryNum))
　Next i

　'値を比較
　For i = 1 To UBound(Conf(1).aryNum)
　　For j = 1 To UBound(Conf(2).aryNum)
　　　If Conf(1).aryNum(i) = Conf(2).aryNum(j) Then
　　　　'値が合致していれば、合致フラグをonにする。
　　　　Conf(1).aryFlg(i) = True
　　　　Conf(2).aryFlg(j) = True
'　　　　GoTo CONTINUE:'(2).xlsmのチェックを途中で切り上げるなら、コメントアウトを解除。
　　　End If
　　Next j
CONTINUE:
　Next i
End Sub

Private Sub OutputData(Conf As Config)
'引数のデータをシートに出力する。
　Dim i As Long
　Dim cntTrue As Long, cntFalse As Long 'Sheet2及びSheet3に出力する行番号

　cntTrue = 0: cntFalse = 0 '※
　For i = 1 To UBound(Conf.aryNum)
　　If Conf.aryFlg(i) Then
　　　'その値が合致していれば
　　　Conf.Book.Worksheets("Sheet1").Cells(i + 2, 2).Value = "○" '※
　　　cntTrue = cntTrue + 1
　　　Conf.Book.Worksheets("Sheet2").Cells(cntTrue, 1).NumberFormat = "@"
　　　Conf.Book.Worksheets("Sheet2").Cells(cntTrue, 1).Value = Conf.aryNum(i) '※
　　Else
　　　'合致していなければ
　　　cntFalse = cntFalse + 1
　　　Conf.Book.Worksheets("Sheet3").Cells(cntFalse, 1).NumberFormat = "@" '※
　　　Conf.Book.Worksheets("Sheet3").Cells(cntFalse, 1).Value = Conf.aryNum(i) '※
　　End If
　Next i
End Sub

PS
＞プログラムは作文と同じ(中略)順番に翻訳していくだけです。
＞試行錯誤で(中略)上達します。
　これは自分も同意します。
　自分は独学ですが、作りたいコードがある→どんな命令を使えばいいのか検索する→実装する、を繰り返して上手くなっていきました。
　いきなり全部を作ろうとするのではなく、一つ一つのステップを順番に作っていけば、案外なんとかなるものです。

お礼

回答頂き、本当にありがとうございました。

作成頂いたコードですが、自分が想定していた動作を再現して頂いており急を要するものでしたので本当に助かりました。
書いて頂いた内容を理解し、ソラで自分一人で組めるようになるよう練習したいと思います。ありがとうございました。

回答No.4

masnoske

勉強しはじめの頃は、自分でフローチャートを書いたほうがいいですよ。
あなたの目標が「1からロジックを組んで書き上げる事」であれば、なおさらです。
ロジックを考える → フローチャートを作る → フローチャートに従ってコーディングする
他の回答にもあるように、コーディング自体は単なる翻訳作業です。

回答No.2

tanakanono

プログラムは作文と同じです。あなたが書いたやりたいことを順番に翻訳していくだけです。
答えに頼るより試行錯誤でどこまでできてどこからできないのかを見つけていくと上達します。
試行錯誤すると応用もできます。答えに頼るとブックが増えたとき、シートが複数の時手も足も出なくなってしまいます。
アビバがどのように教えているのかわかりませんが、先生に聞けるなら試行錯誤でうまくいかないところを聞くとよいと思います。

回答No.1

kkkkkm

ブックを作るのが面倒なのですべてシートにしてますが適宜変更してください。
(2).xlsmの2回目の
167311400021200
は「”最初に合致した箇所”」に該当せず
3. (1).xlsmと(2).xlsmのSheet3に、それぞれ 〇 が記入されていない”行すべて”の値を張り付ける
に該当させています。

Sub Test()
Dim c As Range, FRange As Range
Dim Sh1 As Worksheet, Sh2 As Worksheet

Set Sh1 = Worksheets("Sheet1")
Set Sh2 = Worksheets("Sheet2")

For Each c In Sh1.Range(Sh1.Cells(3, "A"), Sh1.Cells(Rows.Count, "A").End(xlUp))
Set FRange = Sh2.Range(Sh2.Cells(3, "A"), Sh2.Cells(Rows.Count, "A").End(xlUp)). _
Find(c.Value, LookAt:=xlWhole, After:=Sh2.Cells(Rows.Count, "A").End(xlUp))
If Not FRange Is Nothing Then
If c.Value = FRange.Value Then
c.Offset(0, 1).Value = "◯"
'↓(1).xlsmSheet2に
Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Value = c.Value
FRange.Offset(0, 1).Value = "◯"
End If
Else
'↓(1).xlsmのSheet3に
Sheets("Sheet5").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Value = c.Value
End If
Next
For Each c In Sh2.Range(Sh2.Cells(3, "A"), Sh2.Cells(Rows.Count, "A").End(xlUp))
If c.Offset(0, 1).Value = "◯" Then
'↓(2).xlsmのSheet2に
Sheets("Sheet4").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Value = c.Value
Else
'↓(2).xlsmのSheet3に
Sheets("Sheet6").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Value = c.Value
End If
Next
End Sub

お礼

急ぎ回答を作成頂き、本当にありがとうございました。
作成頂いたコードですが、自分が想定していた動作を再現して頂いており急を要するものでしたので本当に助かりました。
書いて頂いた内容を理解し、組めるようになるようkkkkmさんのコードを参考に練習したいと思います。ありがとうございました。