VBAで変数の数／変数名を動的に変化させる

こんにちは。プログラミング初心者です。

VBAで質問です。
以下のようなシートがあるとします。

　A | B | C | D | E | F
1 シート選択 | （プルダウンリストで選択します）
2 果物シート | りんご | みかん | ばなな
3 教科シート | 国語 | 算数 | 理科 | 社会 | 図工 | 体育
4 乗物シート | 車 | 電車 | 船 | 飛行機

そして、以下のようにB1セルのプルダウンで選択されたシート名をA列で検索してヒットした行の文字列を配列に格納します。

selectedSheet = cells(1, 2).Value

for i = 2 To 4
if cells(i , 1).Value = selectedSheet Then
rightRow = Cells(i, Columns.Count).End(xlToLeft).Column
Redim rowArray(rightRow - 1)
for j = 1 To rightRow
rowArray(j - 1) = cells(i, j).Value
Next j
Exit For
End if
next i

次に、配列に格納された文字列をB1のプルダウンで選択されたシートの1行目で、配列の各要素を検索して、それぞれが何列目にあるかを調べます。

sheetName = rowArray(0)
sheetObject = Worksheets(sheetName)
lastColumn = sheetObject.Cells(1, Columns.Count).End(xlToLeft).Column
Set searchRange = sheetObject.Range((cells(1, 1), cells(1, lastColumn))

col_01 = Find(rowArray(1), searchRange)　 'りんごを検索してます
col_02 = Find(rowArray(2), searchRange)　 'みかんを検索してます
col_03 = Find(rowArray(3), searchRange)　 'バナナを検索してます

その後、これで得られた列情報をもとにいろいろと処理をするのですが、上記のように「col_01 = ***」のような書き方ができるのは、あらかじめ「果物シート」がセラばれることが分かっている場合のみです。

「教科シート」が選択された場合は、「col_**」の「**」の部分が「6」まである必要がありますし、「乗物シート」の場合は変数が4つになります。

このように必要となる変数の数が動的に変化する場合に変化する場合、どのように処理したらよいでしょうか。

最初の「for i = 2 To 4」のループとのころで、ヒットしたシート名によって、それぞれ別のSubやFunctionを呼ぶというのは避けたいです。

というのも、VBAをまったく知らないユーザでも上記テーブルの「果物シート」行に「メロン」を足したり、「乗物シート」の「飛行機」を削除することで、処理対象列を自由にカスタマイズできるようにしてあげたいのです。

（あるいは、乗物シートの下に「肩書シート | 社長 | 部長| 係長」のような行を挿入して、処理対象のシートそのものを増やしたり）

どなたか、よい方法をご存知でしたら、教えていただけないでしょうか。
よろしくお願いいたします。

No.4 ベストアンサー 回答者： end-u 回答日時： 2012/04/03 22:24

途中から失礼します。

結局、
Sub try()
　　Dim s As String
　　Dim r As Range
　　Dim n As Long
　　Dim i As Long
　　Dim x, y, z

　　With ActiveSheet
　　　　s = .Cells(1, 2).Value
　　　　x = Application.Match(s, .Columns(1), 0)
　　　　n = .Cells(x, .Columns.Count).End(xlToLeft).Column - 1
　　　　If n = 0 Then MsgBox "no data": Exit Sub
　　　　y = Application.Transpose(.Cells(x, 2).Resize(, n))
　　　　y = Application.Transpose(y)
　　End With

　　With Sheets(s)
　　　　z = Application.Match(y, .Rows(1), 0)
　　　　If n = 1 Then
　　　　　　If IsNumeric(z) Then
　　　　　　　　Set r = .Columns(z)
　　　　　　End If
　　　　Else
　　　　　　For i = 1 To UBound(z)
　　　　　　　　If IsNumeric(z(i)) Then
　　　　　　　　　　If r Is Nothing Then
　　　　　　　　　　　　Set r = .Columns(z(i))
　　　　　　　　　　Else
　　　　　　　　　　　　Set r = Union(r, .Columns(z(i)))
　　　　　　　　　　End If
　　　　　　　　End If
　　　　　　Next
　　　　End If
　　End With

　　If Not r Is Nothing Then
　　　　r.Copy Worksheets.Add.Range("A1")
　　　　Set r = Nothing
　　End If
End Sub

こういう事なんでしょうか。
列位置を変数にとって、必要な列だけを別シートに抜き出すという処理。
行方向のLoopに条件分岐処理がないなら列ごとコピーで良さそうですが。
上記例みたく。

でもそういう処理の場合で、抜き出す項目名が必ず元データにある、
という事が保証されているならAdvancedFilterメソッドが簡単です。

Sub try_2()
　　Dim s As String
　　Dim n As Long
　　Dim x

　　With ActiveSheet
　　　　s = .Cells(1, 2).Value
　　　　x = Application.Match(s, .Columns(1), 0)
　　　　n = .Cells(x, .Columns.Count).End(xlToLeft).Column - 1
　　　　If n = 0 Then MsgBox "no data": Exit Sub
　　　　.Cells(x, 2).Resize(, n).Copy Worksheets.Add.Range("A1")
　　End With

　　Sheets(s).Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
　　　　　　CopyToRange:=Range("A1").Resize(, n), Unique:=False
End Sub

もしLoop処理が必要な場合でも、１セルずつ書き出しているから遅いんであって、
一旦、配列に入れて、書き出しはまとめて１回で済ますようにすれば速度的にも改善します。

この回答へのお礼

ご回答ありがとうございます！

すごい！いろいろ勉強させていただきました。

Matchの検索対象に2次配列が指定できること。そしてその結果を１次配列で受け取れること。
Unionで連続していない列を１つのオブジェクトとして扱えるようになるというのも目から鱗です。

ちなみに、以下のようなシートがあったとして、key列とその他２列を抽出（コピー）する場合は、key列をA列に、その他２列は2つの空白列のに続いて、D列とE列にコピー。

key列とその他3列を抽出（コピー）する場合は、key列はA列に、その他3列は3つの空白列に続いて、E、F、G列にコピーなんてことができるでしょうか？

それともやはり、key列のコピーとその他列の処理を2回に分けてやるしかないでしょうか。

key | りんご | 西瓜 | みかん | バナナ
1 | test | test | test | test
2 | sample | sample | sample | sample
3 | dummy | dummy | dummy | dummy

じつは、コピーしたkey列の左にある空白列に、同名の日付の古いファイルから同じ列名のデータを引っ張ってきて（行が追加／削除されている可能性もあるので、keyの数字を検索キーにVLOOKUPか何かでやる予定）、差分を取りたいのです。

なんだか、お礼というより追加の質問みたいになってしまって恐縮ですが、
そちらの方も余裕がありましたら、お知恵を拝借できないでしょうか。

【key列と、りんご列・みかん列を抽出した際の結果】
key | | | りんご | みかん
1 | | | test | test
2 | | | sample | sample
3 | | | dummy | dummy

お礼日時：2012/04/04 01:18

No.6 回答者： end-u 回答日時： 2012/04/04 12:43

一応、AdvancedFilterメソッドを使った場合のサンプル。

『抜き出す項目名が必ず元データにある、という事が保証』
されてなくても使えるように存在チェックをすれば良いですね。

Sub try_2_kai()
　　Dim s As String
　　Dim n As Long
　　Dim i As Long
　　Dim c As Long
　　Dim x, y, z

　　'ActiveSheetのB1セル値を検索してその右列データを取得
　　With ActiveSheet
　　　　s = .Range("B1").Value
　　　　x = Application.Match(s, .Columns(1), 0)
　　　　If IsError(x) Then MsgBox "error": Exit Sub
　　　　n = .Cells(x, .Columns.Count).End(xlToLeft).Column - 1
　　　　If n = 0 Then MsgBox "no data": Exit Sub
　　　　y = .Cells(x, 2).Resize(, n).Value
　　End With

　　'取得データが元データ項目になければ除外
　　x = Application.Match(y, Sheets(s).Rows(1), 0)
　　ReDim z(1 To n)
　　If n = 1 Then
　　　　If IsNumeric(x) Then
　　　　　　c = 1
　　　　　　z(c) = y
　　　　End If
　　Else
　　　　For i = 1 To n
　　　　　　If IsNumeric(x(i)) Then
　　　　　　　　c = c + 1
　　　　　　　　z(c) = y(1, i)
　　　　　　End If
　　　　Next
　　End If

　　'新規Sheetに除外後データをセットしてAdvancedFilter
　　If c = 0 Then MsgBox "no data": Exit Sub
　　With Sheets.Add.Range("A1").Resize(, c)
　　　　.Value = z
　　　　Sheets(s).Range("A1").CurrentRegion.AdvancedFilter _
　　　　　　　　Action:=xlFilterCopy, _
　　　　　　　　CopyToRange:=.Cells
　　　　If c > 1 Then
　　　　　　.Item(2).Resize(, c - 1).EntireColumn.Insert
　　　　End If
　　End With
End Sub

この回答へのお礼

ご丁寧にありがとうございます！

じつは、昨日の今頃AdvancedFilterで任意の列だけxlFilterCopyするにはどうしたらいいんだろうと、試行錯誤していたのですが、以下の部分の「With Sheets.Add.Range("A1").Resize(, c)」のようにコピー先の範囲を指定してあげればよかったんですね。

With Sheets.Add.Range("A1").Resize(, c)
.Value = z
Sheets(s).Range("A1").CurrentRegion.AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Cells

以下の部分のようにヒットした列番号をソートする個所といい、自分じゃ絶対思いつかなかったですね。今後これを自分の引き出しに入れておこうと思います。

ありがとございました。勉強になりました。

If IsNumeric(x(i)) Then
　　　　　　　　c = c + 1
　　　　　　　　z(c) = y(1, i)
　　　　　　End If

お礼日時：2012/04/05 01:19

No.5 回答者： end-u 回答日時： 2012/04/04 02:19

>それともやはり、key列のコピーとその他列の処理を2回に分けてやるしかないでしょうか。

別にUnionメソッドを使って一括でやらなくても、
１列ずつコピーしても良いかと思います。
各行Loopに比べれば。

>じつは、コピーしたkey列の左にある空白列に、
>同名の日付の古いファイルから同じ列名のデータを引っ張ってきて
>（行が追加／削除されている可能性もあるので、
>keyの数字を検索キーにVLOOKUPか何かでやる予定）、差分を取りたいのです。
この処理はコピーの後に行うんですよね。
コピー後に空白列を設けるという事で良ければ
単純にコピー後、列挿入ではいけませんか。

この回答へのお礼

＞ コピー後に空白列を設けるという事で良ければ単純にコピー後、列挿入ではいけませんか。

おっしゃるとおりですね。
仕様上そうすうわけにいかない事情があったのですが、仕様自体を変更してそういう処理にしようと思います。

お礼日時：2012/04/05 01:22

No.3 回答者： kybo 回答日時： 2012/04/03 16:47

変数をcol_01とかcol_02とかしないといけないという考え方がずれています。

後の処理がどういう処理なのかわかりませんが、どうしても個々に変数に入れたいのであれば、
以下の様にすればよろしいかと思います。

ReDim col(UBound(rowArray))
For i = 0 To UBound(rowArray)
　col(i) = Find(rowArray(i), searchRange).Column
Next i

この回答へのお礼

たびたびのご回答ありがとうございます。

やっぱり、そうするしかないですよね。
実は、自分で書いた現状のコードがそういうかたちになってます。

この後、「果物シート」とか「乗物シート」の2行目から最終行までForでループしつつ、col()の配列を読み込むループをネストして処理していくことになるのですが、本番データは平均して数千行あるために処理に時間がかかってしまいます。

【現状を単純化したイメージ】
for i = 2 to lastRow
for j = 0 to elementNum
if j = 0 then
colNum = 1
cells(i, colNum).value = 果物シート.cells(i, j).value
else
cells(i, colNum + j).value = 果物シート.cells(i, j).value
end if
next j
next i
※ i のループが1000、jのループが3として3000ステップ (+if分岐）

これを以下のように、できればかなり処理速度が改善されるはずだと思ったわけです。
（col()の要素が3つなら単純に1/3になるはず）

【改善案のイメージ】
for i = 2 to lastRow
cells(i, colNum1).value = 果物シート.cells(i, col_01).value
cells(i, colNum2).value = 果物シート.cells(i, col_02).value
cells(i, colNum3).value = 果物シート.cells(i, col_03).value
next i
※ i のループの1000ステップのみ

PHPでCSVの任意のカラム（複数）を読み込む処理をググってみても、やっぱりだいたいforのループにfor each をネストする形になっていますし、そういうものなのかもしれませんね（PHPだとそれほど処理が遅いとも思いませんが…サーバの性能がいいだけかもしれません）。

お礼日時：2012/04/03 17:54

No.2 回答者： kybo 回答日時： 2012/04/03 10:19

配列の最大数を取得するには、UBoundを使います。

後の処理がどういう処理なのか不明ですが、変数はcolの1つだけにしておいて、
以下のような感じにされてはどうでしょうか

Sub test()
Dim I As Integer
For I = 1 To UBound(rowArray)
　col = Find(rowArray(I), searchRange)
　'後の処理
Next I
End Sub

この回答への補足

ご回答ありがとうございます。

説明が分かりづらくて申し訳ありません。

冒頭に示したシートとは別に「果物シート」「乗物シート」があるという想定です。
（本番データはもっとマジメな業務用のデータですが…）

冒頭で示したシートは、それらのシートのどの列の情報を取得するかという定義用のものなのです。
（ここをVBAを知らない一般のユーザがいじることで自由にツールをカスタマイズできるという意図）

例）果物シート
　A | B | C | D | E | F
1 りんご | みかん | ばなな | メロン | スイカ | トマト?
2 オフシーズン | ハウス物 | 輸入物 | 高級品 | 夏物 | 露地物
3 値上がり | 値上がり | 同じ | いつも高い | N/A | 値上がり
4 赤 | オレンジ | 黄色 | 黄緑 | 深緑 | 赤

さて、質問冒頭で示したシートで「果物シート」が選択されると、Uboud(rowArray)が2で、+1すれば要素数が判ります。

更に、配列内に格納された列名を「果物シート内」の1行目で検索すると、リンゴ列、ミカン列、バナナ列は、それぞれ1列目、2列目、3列目にあることがわかります。これが、質問の最後に示したい以下の部分です（Find(rowArray(*), searchRange).columnとすべきでしたが）。

col_01 = Find(rowArray(1), searchRange)　 'りんごを検索してます
col_02 = Find(rowArray(2), searchRange)　 'みかんを検索してます
col_03 = Find(rowArray(3), searchRange)　 'バナナを検索してます

ここで、あらかじめ「果物シート」が選択されることがわかっていれば、col_01、col_02、col_03と3つの変数を宣言しておいて、処理対象列の番号を格納しておけばいいのですが（例：columns(col_01)のように使う予定です）、「教科シート」なら6つ（col_01～col_06）、「乗物シート」なら4つの変数を宣言しておく必要があります。

本番データでは、1列目、2列目、3列目なんて連続していることはありませんし、処理対象とする列数も2～10の間で変化します。

また、配列に格納された列名を処理対象シートの1行目で検索し、列番号をcol_0*に格納する以下のような処理も、あらかじめ「果物シート」が選択されることがわかっているときのみ有効です。

for i = 0 To Ubound(rowArray)
if i = 0 then
col_01 = Find(rowArray(i), searchRange).Column
elseif i = 1 then
col_02 = Find(rowArray(i), searchRange).Column
elseif i = 2 then
col_03 = Find(rowArray(i), searchRange).Column
next i

このあたりの処理で、冒頭のテーブルB2で「教科シート」や「乗物シート」が選ばれたときにも、柔軟に対応できるようにするには、どうしたらよいでしょうか。

補足日時：2012/04/03 13:27

No.1 回答者： D-Matsu 回答日時： 2012/04/03 09:54

ユーザはシートしかいじらない（VBAコードは触らない）でいいんですよね？

終端行を別途取得して、動的配列で処理するのがいいんじゃないですか。