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

Question

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

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

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

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

end-u · Accepted Answer

途中から失礼します。
結局、
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処理が必要な場合でも、１セルずつ書き出しているから遅いんであって、
一旦、配列に入れて、書き出しはまとめて１回で済ますようにすれば速度的にも改善します。

end-u · Answer

一応、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

end-u · Answer

>それともやはり、key列のコピーとその他列の処理を2回に分けてやるしかないでしょうか。
別にUnionメソッドを使って一括でやらなくても、
１列ずつコピーしても良いかと思います。
各行Loopに比べれば。

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

kybo · Answer

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

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

kybo · Answer

配列の最大数を取得するには、UBoundを使います。
後の処理がどういう処理なのか不明ですが、変数はcolの1つだけにしておいて、
以下のような感じにされてはどうでしょうか

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

D-Matsu · Answer

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

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

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

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

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

途中から失礼します。

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

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

この回答への補足

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

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング