VBAマクロでワークシートを見比べて判定したい

質問

VBAマクロでワークシートを見比べて判定したい

Workbook A.xlsとWorkbook B.xlsがあります。
AにBの情報をいれ、修正したい

A.xls（sheet1)
番号　　判定
1111　　　1
2222　　　0
3333　　　1
4444　　　1

B.xls（sheet1)
番号　　
3333　　　
5555

判定の１は未完　0は完了

Bのファイルに出てくる番号は未完（１）、
出てこないものは完了（０）

つまり上の結果のA.xlsは
番号　　判定
1111　　　0
2222　　　0
3333　　　0
4444　　　1
5555　　　1

A.xlsには過去の分に併せ、Bに出てきたものすべてを出します。

マクロ初心者で基本的なことかもしれないのですが、ご教授願いますｍ（＿＿）ｍ

回答No.1

nattocurry · ベストアンサー

処理するに当たって、

既にA.xlsにある判定はリセットし、改めて判定し直す。
A.xlsに無い番号がB.xlsにあったら、A.xlsに追加する。
B.xlsに無かったら判定は0、B.xlsに有ったら判定は1とする。
番号順に並べる。

ということでよいですか？

データはちゃんと詰まっていて、間に空行が無いものとして処理しています。

両方のブックを開いた状態で実行してください。

Sub test()
Dim ShA As Worksheet, ShB As Worksheet
Set ShA = Workbooks("A.xls").Worksheets(1)
Set ShB = Workbooks("B.xls").Worksheets(1)

Dim RowA As Long, RowB As Long

RowA = 2
Do Until ShA.Cells(RowA, 1).Value = ""
Cells(RowA, 2).Value = 0
RowA = RowA + 1
Loop

RowB = 2
Do Until ShB.Cells(RowB, 1).Value = ""
Dim Fnd As Range
Set Fnd = ShA.Columns(1).Find(ShB.Cells(RowB, 1).Value, , , xlWhole)
If Fnd Is Nothing Then
With ShA.Cells(ShA.Rows.Count, 1).End(xlUp).Offset(1)
.Value = ShB.Cells(RowB, 1).Value
.Offset(, 1).Value = 1
End With
Else
Fnd.Offset(, 1).Value = 1
End If
RowB = RowB + 1
Loop

Columns("A:B").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1

End Sub

お礼

判定はご推察のとおりです。質問の仕方が悪くてすみません＞＜；

まずはお礼だけさせていただきますｍ（＿＿）ｍ

回答No.2

mitarashi

配列数式を復習しておりました。本御質問には無理矢理な回答だと思いますが、ご参考まで。

Sub test()
Dim refRange As Range, targetRange As Range, mycell As Range

With Workbooks("B.xls").Sheets("Sheet1")
Set refRange = .Range(.Range("A2"), .Range("A" & .Rows.Count).End(xlUp))
End With
With Workbooks("A.xls").Sheets("Sheet1")
Set targetRange = .Range(.Range("A2"), .Range("A" & .Rows.Count).End(xlUp))
End With
For Each mycell In targetRange.Offset(0, 1)
mycell.FormulaArray = "=(SUM((RC[-1]=[B.xls]Sheet1!" & refRange.Address(ReferenceStyle:=xlR1C1) & ")*1)>0)*1"
Next mycell
targetRange.Offset(0, 1).Value = targetRange.Offset(0, 1).Value
End Sub

お礼

違う角度でのご回答ありがとうございます＾＾
今後の参考にさせていただきます。