| |
▼TODD さん：
別案もアップしておきます。
２回目、３回目の条件は、先にコメントした通りです。
下記の Test2 が、TODDさんがループで処理しようとしておられた流れになるかと思います。
Test3 は、同じループなら、効率を考えて、一工夫したもの。
F列等の件数が少なければアップ済みの Test でも問題ないかと思いますが
件数が膨大ならTest3ですね。
で、残念ながら、Test2 は、最も効率の悪い方式になります。
Sub test2()
Dim col As Long
Dim i As Long
Dim x As Long
Dim mx As Long
Application.ScreenUpdating = False
mx = Range("A" & Rows.Count).End(xlUp).Row
col = Cells(1, Columns.Count).End(xlToLeft).Column
With Range(Cells(1, col), Cells(Rows.Count, col).End(xlUp)).Resize(, 3)
For i = 1 To .Rows.Count
.Cells(i, 2).Resize(, 2).ClearContents
For x = 1 To mx
If .Cells(i, 1).Value = Cells(x, "A").Value Then
.Cells(i, 2).Value = Cells(x, "B").Value
.Cells(i, 3).Value = Cells(x, "C").Value
Exit For
End If
Next
Next
End With
End Sub
Sub test3()
Dim dic As Object
Dim c As Range
Dim col As Long
Dim x As Long
Dim v As Variant
Dim w As Variant
Set dic = CreateObject("Scripting.Dictionary")
For Each c In Range("A1", Range("A" & Rows.Count).End(xlUp))
dic(c.Value) = c.Offset(, 1).Resize(, 2).Value
Next
col = Cells(1, Columns.Count).End(xlToLeft).Column
v = Range(Cells(1, col), Cells(Rows.Count, col).End(xlUp)).Value
ReDim Preserve v(1 To UBound(v, 1), 1 To 3)
For x = 1 To UBound(v, 1)
If dic.exists(v(x, 1)) Then
w = dic(v(x, 1))
v(x, 2) = w(1, 1)
v(x, 3) = w(1, 2)
End If
Next
Cells(1, col).Resize(UBound(v, 1), UBound(v, 2)).Value = v
End Sub
|
|
β
- 16/5/21(土) 23:38 -
I
- 16/5/21(土) 23:08 -
GG
- 16/5/17(火) 3:57 -
γ
- 16/5/14(土) 12:30 -
