| |
▼ドカ さん：
こんにちは。
以下のコードが、はたしてドガさんんが望んでおられるようなコードかどうか
はなはだ自信はありませんが・・・
ところで、アップされたサンプルデータ、一方が、全角で４月、他方が半角で4月。
このままでは、これはマッチしませんよ。
Sub Sample()
Dim dKey As String
Dim c As Range
Dim dic As Object
Dim v As Variant
Dim i As Long
Dim j As Long
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1") '元シート
For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
dKey = c.Value & vbTab & c.Offset(, 1).Value
dic(dKey) = dic(dKey) + c.Offset(, 2).Value
Next
End With
With Sheets("Sheet2") '転記シート
v = .Range("A1").CurrentRegion.Value
For i = 2 To UBound(v, 1)
For j = 2 To UBound(v, 2)
dKey = v(1, j) & vbTab & v(i, 1)
v(i, j) = dic(dKey)
Next
Next
.Range("A1").CurrentRegion.Value = v
.Select
End With
Set dic = Nothing
MsgBox "転記が終了しました"
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
