|
▼愛子 さん:
とりあえず↑の理解でコード案を2つほど。
なお、aシートもbシートも1行目がタイトル行、データは2行目からという想定です。
Sub Sample1()
'ループでシート関数MATCHを使う基本形。処理効率は若干落ちる。
Dim nameV As Variant
Dim amtV As Variant
Dim newV As Variant
Dim i As Long
Dim z As Variant
With Sheets("a")
'aシートの名前列と金額列を配列に格納(2行目以降)
With .Range("E2", .Range("E" & .Rows.Count).End(xlUp))
nameV = .Cells.Value
amtV = .Offset(, 7).Value
End With
End With
With Sheets("b")
'bシートの N列、O列の内容(2行目以降)を配列に格納
newV = .Range("N2", .Range("N" & .Rows.Count).End(xlUp)).Resize(, 2).Value
For i = 1 To UBound(newV, 1)
z = Application.Match(newV(i, 1), nameV, 0)
If IsNumeric(z) Then newV(i, 2) = amtV(z, 1)
Next
.Range("N2").Resize(UBound(newV, 1), UBound(newV, 2)).Value = newV
.Select
End With
End Sub
Sub Sample2()
'Dictionary処理案。
Dim c As Range
Dim newV As Variant
Dim i As Long
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("a")
'aシートの名前と金額をDictionaryに格納(2行目以降)
For Each c In .Range("E2", .Range("E" & .Rows.Count).End(xlUp))
dic(c.Value) = c.EntireRow.Range("L1").Value
Next
End With
With Sheets("b")
'bシートの N列、O列の内容(2行目以降)を配列に格納
newV = .Range("N2", .Range("N" & .Rows.Count).End(xlUp)).Resize(, 2).Value
For i = 1 To UBound(newV, 1)
If dic.exists(newV(i, 1)) Then newV(i, 2) = dic(newV(i, 1))
Next
.Range("N2").Resize(UBound(newV, 1), UBound(newV, 2)).Value = newV
.Select
End With
End Sub
|
|