こんにちは。プログラミング初心者です。
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ベストアンサー
- 回答日時:
途中から失礼します。
結局、
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処理が必要な場合でも、1セルずつ書き出しているから遅いんであって、
一旦、配列に入れて、書き出しはまとめて1回で済ますようにすれば速度的にも改善します。
ご回答ありがとうございます!
すごい!いろいろ勉強させていただきました。
Matchの検索対象に2次配列が指定できること。そしてその結果を1次配列で受け取れること。
Unionで連続していない列を1つのオブジェクトとして扱えるようになるというのも目から鱗です。
ちなみに、以下のようなシートがあったとして、key列とその他2列を抽出(コピー)する場合は、key列をA列に、その他2列は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
No.6
- 回答日時:
一応、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
No.5
- 回答日時:
>それともやはり、key列のコピーとその他列の処理を2回に分けてやるしかないでしょうか。
別にUnionメソッドを使って一括でやらなくても、
1列ずつコピーしても良いかと思います。
各行Loopに比べれば。
>じつは、コピーしたkey列の左にある空白列に、
>同名の日付の古いファイルから同じ列名のデータを引っ張ってきて
>(行が追加/削除されている可能性もあるので、
>keyの数字を検索キーにVLOOKUPか何かでやる予定)、差分を取りたいのです。
この処理はコピーの後に行うんですよね。
コピー後に空白列を設けるという事で良ければ
単純にコピー後、列挿入ではいけませんか。
> コピー後に空白列を設けるという事で良ければ単純にコピー後、列挿入ではいけませんか。
おっしゃるとおりですね。
仕様上そうすうわけにいかない事情があったのですが、仕様自体を変更してそういう処理にしようと思います。
No.3
- 回答日時:
変数を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だとそれほど処理が遅いとも思いませんが…サーバの性能がいいだけかもしれません)。
No.2
- 回答日時:
配列の最大数を取得するには、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で「教科シート」や「乗物シート」が選ばれたときにも、柔軟に対応できるようにするには、どうしたらよいでしょうか。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
このQ&Aを見た人はこんなQ&Aも見ています
-
これまでで一番「情けなかったとき」はいつですか?
これまでの人生で一番「情けない」と感じていたときはいつですか? そこからどう変化していきましたか?
-
3分あったら何をしますか?
カップ麺にお湯を入れて、できるまでの3分間で皆さんは何をしていますか?
-
【大喜利】看板の文字を埋めてください
旅行先でほぼ消えかけている看板に出会いました。 何を気を付ければいいのか穴埋めをして教えてください。
-
集合写真、どこに映る?
あなたが集合写真を撮られるとき、画角のどのあたりにいることが多いですか? 私は振り返ってみると右の端にいることが多い気がします。
-
14歳の自分に衝撃の事実を告げてください
タイムマシンで14歳の自分のところに現れた未来のあなた。 衝撃的な事実を告げて自分に驚かせるとしたら何を告げますか?
-
VBAでループ内で使う変数名を可変にできないか。
Visual Basic(VBA)
-
VBA 変数名に変数を使用したい。
Visual Basic(VBA)
-
変数を動的に作るには?
Visual Basic(VBA)
-
-
4
Excel-vba 文字列と変数を連結して更に変数として扱いたい
その他(プログラミング・Web制作)
-
5
配列をループでたくさん宣言したいのですが、配列名や変数名を変数で宣言することはできませんか?
Visual Basic(VBA)
-
6
配列を使わずに、変数名を動的にループで回したい
C言語・C++・C#
-
7
ユーザーフォームに入力したデータを保持する方法
Visual Basic(VBA)
-
8
Application.ScreenUpdating = Falseが効きません
Visual Basic(VBA)
-
9
変数名の取得
Visual Basic(VBA)
-
10
VBA:小数点以下の数字を取得できる関数は?
Visual Basic(VBA)
-
11
エクセルのラベルの値(文字列)を垂直方向で中央揃えにするには?
Excel(エクセル)
-
12
押したボタンの位置取得(共通のマクロ)
Excel(エクセル)
-
13
VBAで配列の計算
Excel(エクセル)
-
14
エクセルでアルファベットか数値の判定をしたいのですが
Excel(エクセル)
-
15
Excel、VBAのユーザーフォームのラベルで変数を…
Excel(エクセル)
-
16
VBAコード記述に際して、コード全体を自動的にインデント付ける方法
Access(アクセス)
-
17
2つ目のレコードの値を取得するには?
Access(アクセス)
-
18
エクセル・VBA CheckBoxのオブジェクト名に変数を使うことは可能でしょうか?
Excel(エクセル)
-
19
VBA シートをコピーする際に Copyメソッドは失敗しましたのエラーが出てしまいます
Visual Basic(VBA)
-
20
ユーザーフォームを表示中にシートの操作をさせるには
Excel(エクセル)
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・「みんな教えて! 選手権!!」開催のお知らせ
- ・漫画をレンタルでお得に読める!
- ・【選手権お題その2】この漫画の2コマ目を考えてください
- ・2024年に成し遂げたこと
- ・3分あったら何をしますか?
- ・何歳が一番楽しかった?
- ・治せない「クセ」を教えてください
- ・【大喜利】看板の文字を埋めてください
- ・【大喜利】【投稿~12/17】 ありそうだけど絶対に無いことわざ
- ・【選手権お題その1】これってもしかして自分だけかもしれないな…と思うあるあるを教えてください
- ・【穴埋めお題】恐竜の新説
- ・我がまちの「給食」自慢を聞かせてっ!
- ・冬の健康法を教えて!
- ・一番好きな「クリスマスソング」は?
- ・集合写真、どこに映る?
- ・自分の通っていた小学校のあるある
- ・フォントについて教えてください!
- ・これが怖いの自分だけ?というものありますか?
- ・スマホに会話を聞かれているな!?と思ったことありますか?
- ・それもChatGPT!?と驚いた使用方法を教えてください
- ・見学に行くとしたら【天国】と【地獄】どっち?
- ・これまでで一番「情けなかったとき」はいつですか?
- ・この人頭いいなと思ったエピソード
- ・あなたの「必」の書き順を教えてください
- ・10代と話して驚いたこと
- ・14歳の自分に衝撃の事実を告げてください
- ・人生最悪の忘れ物
- ・あなたの習慣について教えてください!!
- ・都道府県穴埋めゲーム
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
マクロの「SaveAs」でエラーが...
-
EXCELのSheet番号って変更でき...
-
マクロ実行後に別シートの残像...
-
ExcelのVBA ListBox.RowSource...
-
Count Ifのセルの範囲指定に変...
-
ExcelのVBマクロを、バックグラ...
-
VBA 実行時エラー1004 rangeメ...
-
楽天RSSからエクセルVBAを使用...
-
VBA シート間の転記で、条件の...
-
VBA 別ブックからの転記の高速...
-
EXCEL VBA 転記 条件分岐 新...
-
Excel VBA オートフィルターで...
-
VBA 空白行に転記する
-
VBAで変数の数/変数名を動的に...
-
100万件越えCSVから条件を満た...
-
アクセスからエクセルへ出力時...
-
VBA シリアル値から月日への変換
-
GASでチェックボックスを一括of...
-
複数シートの複数列に入力され...
-
【VBA】特定の条件でセルをコピー
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
マクロの「SaveAs」でエラーが...
-
マクロ実行後に別シートの残像...
-
EXCELのSheet番号って変更でき...
-
VBA 空白行に転記する
-
Count Ifのセルの範囲指定に変...
-
Changeイベントで複数セルへの...
-
VBAで変数の数/変数名を動的に...
-
VBA別シートの最終行の次行へ転...
-
楽天RSSからエクセルVBAを使用...
-
Excel2013で切り取り禁止
-
【VBA】特定の条件でセルをコピー
-
Unionでの他のシートの参照につ...
-
VBA 実行時エラー1004 rangeメ...
-
ExcelのVBマクロを、バックグラ...
-
100万件越えCSVから条件を満た...
-
複数シートの複数列に入力され...
-
VBA 別ブックからの転記の高速...
-
VBA Userformで一部別シートに...
-
テキストボックスから、複数の...
-
Excel VBA オートフィルターで...
おすすめ情報