回答編集履歴

1

コード追記

2020/05/02 05:37

投稿

hatena19
hatena19

スコア34075

test CHANGED
@@ -89,3 +89,77 @@
89
89
  End Sub
90
90
 
91
91
  ```
92
+
93
+
94
+
95
+ 上記は元コードをそのまま配列用に修正してものですが、私がコーディングするなら下記のようなコードになります。
96
+
97
+
98
+
99
+ これなら、表がA1からでなくても、`.Range("A1")`の部分を書き換えるだけで済みます。
100
+
101
+
102
+
103
+ ```vba
104
+
105
+ Sub 条件1()
106
+
107
+ Dim bk1 As Workbook, bk2 As Workbook
108
+
109
+ Set bk1 = ThisWorkbook 'Workbooks("A")
110
+
111
+ Set bk2 = ThisWorkbook 'Workbooks("B")
112
+
113
+
114
+
115
+ '表範囲取得
116
+
117
+ Dim rg1 As Range, rg2 As Range
118
+
119
+ Set rg1 = bk1.Worksheets("情報").Range("A1").CurrentRegion
120
+
121
+ Set rg2 = bk2.Worksheets("結果").Range("A1").CurrentRegion
122
+
123
+ ' On Error Resume Next
124
+
125
+
126
+
127
+ Dim a1(), a2()
128
+
129
+ a1 = rg1.Value
130
+
131
+ a2 = rg2.Value
132
+
133
+
134
+
135
+ Dim i As Long, s As Long, x As Long, y As Long, z As Long
136
+
137
+ For i = 2 To UBound(a1, 1)
138
+
139
+ For s = 2 To UBound(a2, 1)
140
+
141
+ For x = 2 To UBound(a1, 2)
142
+
143
+ For y = 2 To UBound(a2, 2)
144
+
145
+ If a1(1, x) = a2(s, 1) And a1(i, 1) = a2(1, y) Then
146
+
147
+ a2(s, y) = a1(i, x)
148
+
149
+ End If
150
+
151
+ Next y
152
+
153
+ Next x
154
+
155
+ Next s
156
+
157
+ Next i
158
+
159
+
160
+
161
+ rg2.Value = a2
162
+
163
+ End Sub
164
+
165
+ ```