回答編集履歴

2

書式の改善

2018/11/03 05:20

投稿

mattuwan
mattuwan

スコア2136

test CHANGED
@@ -120,6 +120,8 @@
120
120
 
121
121
 
122
122
 
123
+ ```VBA
124
+
123
125
  '関数入力案
124
126
 
125
127
  Sub test1()
@@ -216,6 +218,8 @@
216
218
 
217
219
  End Sub
218
220
 
221
+ ```
222
+
219
223
 
220
224
 
221
225
  Vlookup関数の話があったのでそちらに引きずられましたが、

1

誤字の修正&コードの追記

2018/11/03 05:20

投稿

mattuwan
mattuwan

スコア2136

test CHANGED
@@ -4,7 +4,7 @@
4
4
 
5
5
  Index関数とMatch関数の組み合わせの間違いでは?
6
6
 
7
- VLook関数だと2列目索引に出来ないので、
7
+ VLookup関数だと2列目索引に出来ないので、
8
8
 
9
9
  他のアプローチが必要かと思います。
10
10
 
@@ -32,11 +32,11 @@
32
32
 
33
33
 
34
34
 
35
- 変に、「プログラミングをするんだ」と、肩を張らず、
35
+ 変に、「プログラミングをするんだ」と、肩を張らず、
36
36
 
37
37
  エクセル君に任せられるところは任せて、
38
38
 
39
- 自分は手順だけを指示してやるように考えてみてはいかがでしょうか?
39
+ 自分は作業の手順だけを指示してやるように考えてみてはいかがでしょうか?
40
40
 
41
41
 
42
42
 
@@ -113,3 +113,123 @@
113
113
  高速化などの話もいろいろ話が出来るかなとは思いますが、
114
114
 
115
115
  そこまでは望んでないのでしょうかね。
116
+
117
+
118
+
119
+ 時間が出来たので、コードを追記しておきます。
120
+
121
+
122
+
123
+ '関数入力案
124
+
125
+ Sub test1()
126
+
127
+ Dim rngTable As Range '更新対象の表
128
+
129
+ Dim rngKey As Range '検索の索引になるセル範囲
130
+
131
+ Dim rngTemp As Range '数式を一時的に入れるセル範囲
132
+
133
+ Dim rngList As Range '変更の元となる一覧表
134
+
135
+ Dim strFormula As String '数式とする文字列
136
+
137
+
138
+
139
+ 'セル範囲特定
140
+
141
+ With Sheets("学科").Range("A1").CurrentRegion
142
+
143
+ Set rngTable = .Cells
144
+
145
+ Set rngKey = Intersect(.Offset(1), .Columns(2))
146
+
147
+ Set rngTemp = Intersect(.Offset(1).EntireRow, .Columns(.Columns.Count + 1))
148
+
149
+ End With
150
+
151
+ With Sheets("学部").Range("A1").CurrentRegion
152
+
153
+ Set rngList = Intersect(.Cells, .Offset(1))
154
+
155
+ End With
156
+
157
+
158
+
159
+ '1行目の数式の作成(2行目以降はエクセル君に任せる)
160
+
161
+ strFormula = "=INDEX(" & rngList.Address(, , , True) & ",MATCH(" & _
162
+
163
+ rngKey(1).Address(False, False, , external:=True) & "," & _
164
+
165
+ rngList.Columns(2).Address(, , , True) _
166
+
167
+ & ",0),1)"
168
+
169
+
170
+
171
+ '数式の入力
172
+
173
+ rngTemp.Formula = strFormula
174
+
175
+ '値のみ転記
176
+
177
+ rngTemp.Copy
178
+
179
+ rngKey.PasteSpecial xlPasteValues
180
+
181
+ '作業列のクリア
182
+
183
+ rngTemp.ClearContents
184
+
185
+ End Sub
186
+
187
+
188
+
189
+ '繰返し置き換える案
190
+
191
+ Sub test2()
192
+
193
+ Dim rngList As Range
194
+
195
+ Dim rngTable As Range
196
+
197
+ Dim r As Range
198
+
199
+
200
+
201
+ With Sheets("学部").Range("A1").CurrentRegion
202
+
203
+ Set rngList = Intersect(.Cells, .Offset(1))
204
+
205
+ End With
206
+
207
+ Set rngTable = Sheets("学科").Range("A1").CurrentRegion
208
+
209
+
210
+
211
+ For Each r In rngList.Rows
212
+
213
+ rngTable.Columns(2).Replace r.Cells(2).Value, r.Cells(1).Value
214
+
215
+ Next
216
+
217
+ End Sub
218
+
219
+
220
+
221
+ Vlookup関数の話があったのでそちらに引きずられましたが、
222
+
223
+ 単に置換の話なので置換機能を使った方がコードが簡便ですね。
224
+
225
+ (数式の場合は細かくセルを特定しなきゃいけないのと、
226
+
227
+ 数式を示す文字列を作るのが面倒)
228
+
229
+ 無かった時とかの例外処理も不要だったと思うけど、
230
+
231
+ 一応デバッグとかしてみてください。
232
+
233
+ 速度はどれが速いか興味深いですが、
234
+
235
+ そこまでテストする時間がないのでこの辺で^^;