回答編集履歴

1

追記

2021/07/17 03:13

投稿

jinoji
jinoji

スコア4592

test CHANGED
@@ -1,3 +1,155 @@
1
+ <追記>
2
+
3
+ ```VBA
4
+
5
+ Sub 一致転記2()
6
+
7
+
8
+
9
+ '開始時間
10
+
11
+ Dim ST As Single, ET As Single
12
+
13
+ ST = Timer
14
+
15
+
16
+
17
+ '表示抑制
18
+
19
+ With Application
20
+
21
+ .ScreenUpdating = False
22
+
23
+ .DisplayAlerts = False
24
+
25
+ End With
26
+
27
+
28
+
29
+ '配列作成
30
+
31
+ Dim ws1rng As Range, ws1data As Variant
32
+
33
+ With ThisWorkbook.Sheets("出力")
34
+
35
+ Set ws1rng = .Range("A1", .Cells.SpecialCells(xlCellTypeLastCell))
36
+
37
+ ws1data = ws1rng.Value
38
+
39
+ End With
40
+
41
+ Dim ws2rng As Range, ws2data As Variant
42
+
43
+ With ThisWorkbook.Sheets("データ元")
44
+
45
+ Set ws2rng = .Range("A1", .Cells.SpecialCells(xlCellTypeLastCell))
46
+
47
+ ws2data = ws2rng.Value
48
+
49
+ End With
50
+
51
+ Dim ws3rng As Range, ws3data As Variant
52
+
53
+ With ThisWorkbook.Sheets("マスタ")
54
+
55
+ Set ws3rng = .Range("A1", .Cells.SpecialCells(xlCellTypeLastCell))
56
+
57
+ ws3data = ws3rng.Value
58
+
59
+ End With
60
+
61
+
62
+
63
+ '辞書作成
64
+
65
+ Dim m, i, k, v
66
+
67
+ Set m = CreateObject("Scripting.Dictionary")
68
+
69
+ For i = 3 To UBound(ws3data, 1)
70
+
71
+ k = ws3data(i, 2)
72
+
73
+ v = ws3data(i, 6)
74
+
75
+ m(k) = v
76
+
77
+ Next
78
+
79
+
80
+
81
+ '辞書適用
82
+
83
+ Dim d
84
+
85
+ Set d = CreateObject("Scripting.Dictionary")
86
+
87
+ For i = 2 To UBound(ws2data, 1)
88
+
89
+ k = ws2data(i, 2) & ws2data(i, 4)
90
+
91
+ If m.Exists(k) Then
92
+
93
+ ws2data(i, 14) = m(k)
94
+
95
+ d(k) = ws2data(i, 14)
96
+
97
+ End If
98
+
99
+ Next
100
+
101
+ For i = 2 To UBound(ws1data, 1)
102
+
103
+ k = ws1data(i, 2) & ws1data(i, 3)
104
+
105
+ If d.Exists(k) Then
106
+
107
+ ws1data(i, 6) = d(k)
108
+
109
+ End If
110
+
111
+ Next
112
+
113
+
114
+
115
+ '配列出力
116
+
117
+ ws1rng.Value = ws1data
118
+
119
+ ws2rng.Value = ws2data
120
+
121
+
122
+
123
+ '抑制解除
124
+
125
+ With Application
126
+
127
+ .ScreenUpdating = True
128
+
129
+ .DisplayAlerts = True
130
+
131
+ End With
132
+
133
+
134
+
135
+ '終了時間
136
+
137
+ ET = Timer - ST
138
+
139
+ MsgBox Round(ET / 60, 0) & "." & Round(ET Mod 60, 0)
140
+
141
+
142
+
143
+ End Sub
144
+
145
+
146
+
147
+ ```
148
+
149
+ ---
150
+
151
+ <追記前>
152
+
1
153
  他の方とそんなに変わらないので載せる意味も乏しいですが。
2
154
 
3
155
  ```VBA