VBA研究会で論じられた内容を記録する議事録の11本目（2023/04/01開催分）です。前回の議事録はコチラになります。
前回も引き続きシート間のコピーについて、取り組みました。そして今回が最終回です。
今までは個別の値、もしくは貼り付けられた値が対象でしたが、今回は、より実践的な形に挑戦します。
データを選択してコピー
それでは今回のお題です。
Sheet1にあるテーブルから同じキャリアの携帯電話を使っている人を抽出して、Sheet2に出力してください。
- Sheet1, E2セルの一覧からキャリアを選択します
- 選択したキャリアの人のレコードを抽出して、Sheet2の2行目以降に出力します
- Sheet2のタイトルは入力済です
- 罫線の有無は問いません
イメージにすると、こんな感じです。
実際のコード
それでは実際のコードを見ていきましょう。いずれもSheet1に記述されています。
オートフィルターを使う
最初はオートフィルターを使うコードです。オートフィルターなら簡単に条件を絞れます。
'オートフィルターを使用したコード
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$E$2" Then
'コピー先クリア
Sheets("Sheet2").Range("A2:C" & Rows.Count).Clear
'オートフィルター解除
Me.AutoFilterMode = False
'オートフィルター設定してコピー
With Me.Range("A:C")
.AutoFilter Field:=2, Criteria1:=Target.Text
.Copy Sheets("Sheet2").Range("A1")
End With
Me.AutoFilterMode = False
End If
End Sub
Worksheet_Changeイベントで、特定のセルが変更になった場合の処理は、以下の様に書きます。
If Target.Address = 対象セルのアドレス Then End If End Sub
対象セルのアドレスは、絶対参照の形で記述しましょう。「$E$2」のように行と列の指定の前に「$」が付きます。
また、オートフィルターを指定して選択する場合は、事前にオートフィルターを解除しておきましょう。誤動作の原因なります。
ワークシート.AutoFilterMode = False
で解除できます。コピーが終わった後も解除しておきましょう。
1行ずつ処理をするコード
お次は1行ずつ探してコピーしていく方法です。
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$E$2" Then
'コピー先クリア
Sheets("Sheet2").Range("A2:C" & Rows.Count).Clear
Dim rng As Range
'A列の値入力範囲を検索処理
For Each rng In Intersect(Me.UsedRange, Me.Range("A:A"))
'1行目以外を処理
If rng.Row <> 1 Then
If rng.Offset(0, 1).Text = Target.Text Then
'コピー先の最終行の下にコピーする
With Sheets("Sheet2")
Dim lastRow As Long '最終行を取得する
lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
If .Cells(1, 1).Value <> "" Then lastRow = lastRow + 1
'値をコピー
rng.Resize(1, 3).Copy .Cells(lastRow, 1)
End With
End If
End If
Next
End If
End Sub
Sheet1を1行ずつ確認して、キャリアが指定と同じ場合にSheet2の最終行にコピーしています。ここで大事なのはワークシートの指定列の最終行取得です。
Dim lastRow As Long lastRow = ワークシート.Cells(Rows.Count, 指定列).End(xlUp).Row If ワークシート.Cells(1, 指定列).Value <> "" Then lastRow = lastRow + 1
最後の行は指定列に（列名の表示を含めて）何もない場合に先頭行を返すための工夫です。定番なので覚えておきましょう。
次回は「なんちゃって関数」
いかがでしたか？ここまでAIに作ってもらった問題を解いてみたのですが、結構面白かったです。 次回からは新企画「なんちゃって関数」を作ってみます。徐々に普及しているOffice365、便利なのですが新しく出てきている関数が、以前のExcelで使えないという問題があります。そこを何とかしてみようという訳です。お楽しみに！！
