ExcelVBA 　シート関連

::: note warn
自分用のメモなので、形は整ってないです。
:::
### シートを削除する
```
'ワークシートの削除
Worksheets("シート7").Delete  'シート名指定で削除
Worksheets(3).Delete          '何番目のシートかで指定して削除。あまり使わないほうがいい
シート2.Delete                'オブジェクト名指定で削除

' グラフシートを削除する
Charts("グラフ1").Delete  'シート名指定で削除
Charts(1).Delete          '何番目のシートかで指定して削除。あまり使わないほうがいい
グラフ3.Delete            'オブジェクト名指定で削除
```
### シートを追加する
```
Worksheets.Add   'ワークシートの追加

Charts.Add       ' グラフシートの追加

' 3番目のシートの後に追加
Worksheets.Add After:=Worksheets(3)

' 5番目のシートの前に追加
Worksheets.Add Before:=Worksheets(5)

' 末尾に追加
Worksheets.Add After:=Worksheets(Worksheets.Count)

' シートを2つ追加する
Worksheets.Add After:=Worksheets(Worksheets.Count), Count:=2


' シートを追加して、シート名も変更する方法の一例
With Worksheets.Add()  ' Addの後ろに()をつけると戻り値を返すので、Withが使える
  .Name = "追加シート"
End With
```
### シートを移動する
```
Worksheets("abc").Move After:=Worksheets(Worksheets.Count)

' 別のブックへ移動する
Worksheets("abc").Move Before:=Workbooks("bbb.xlsx").Worksheets(Worksheets.Count)


' 移動先を指定しない場合、新規ブックとして作成される
Worksheets(3).Move
```
### シートをコピーする　　非表示のシートについては注意
```
Sub aaa()

  Worksheets("abc").Copy after:=Worksheets(Worksheets.Count)
  
  ' 別のブックへコピーする
  Workbooks("bbb.xlsx").Activate
  Workbooks("aaa.xlsx").Worksheets("abc").Copy after:=Workbooks("bbb.xlsx").Worksheets(Worksheets.Count)
  
  ' コピー先を指定しない場合、新規ブックとして作成される
  Worksheets(3).Copy

End Sub


Sub bbb()

  Dim wsX As Worksheet
  
  Worksheets("シート1").Copy after:=Worksheets(Worksheets.Count)
  '「シート1」をコピーし、末尾に移動する
  Set wsX = Worksheets(Worksheets.Count)
  'コピー直後に末尾のシートをSetすれば、ほぼ間違いなくコピーしたシートが対象になるはず
  wsX.Name = "コピーしたシート"
  
  '※ Set wsX = ActiveSheet というコードは、間違いが起きやすいので使わないように
  
  
  '*****　非表示のシートについて  **************
  
  'Worksheets("隠しシート").Copy   非表示のシートの場合、このコードはエラーになる
  
  Worksheets("隠しシート").Visible = xlSheetVeryHidden  'VBAでしか再表示できないように非表示にする
  'Worksheets("隠しシート").Visible = xlSheetHidden      ' これは普通に非表示
  
  If Worksheets("隠しシート").Visible = xlSheetHidden Or _
    Worksheets("隠しシート").Visible = xlSheetVeryHidden Then
    '非表示シート、またはVBAでしか再表示できないように非表示になっている場合
    Worksheets("隠しシート").Visible = xlSheetVisible
  End If
  
  Worksheets("隠しシート").Copy after:=Worksheets(Worksheets.Count)
  Set wsX = Worksheets(Worksheets.Count)
  wsX.Name = "コピーした隠しシート"
  'ここまでやれば安全だろうか

End Sub
```
### シートの表示・非表示
```
MsgBox Worksheets("aaa").Visible
  '表示の場合は-1　表示の場合は0
  
If Worksheets("aaa").Visible = xlSheetVisible Then
MsgBox "表示"
ElseIf Worksheets("aaa").Visible = xlSheetHidden Then
MsgBox "非表示"
End If
' TrueとFalseでもいいが、xlSheetVisible,xlSheetHiddenが本来か

Worksheets("aaa").Visible = xlSheetVisible  '表示する
Worksheets("aaa").Visible = xlSheetHidden   '非表示にする
Worksheets("aaa").Visible = True  '表示する
Worksheets("aaa").Visible = False   '非表示にする

Worksheets("aaa").Visible = Not Worksheets("aaa").Visible
'表示と非表示を交互に切り替え
```
### オートフィルタで絞り込んだ結果から、特定列の合計･データ数を取得する
```
Range("B2").AutoFilter Field:=2, Criteria1:="冷蔵庫"  ' 2列を"冷蔵庫"で絞込み

Dim result As Long
Dim rowCount As Long

rowCount = Range("B2").CurrentRegion.Rows.Count - 1
'これは絞込みされている行数ではなく、表全体の行数になる

result = WorksheetFunction.Subtotal(9, Range(Cells(3, 6), Cells(rowCount, 6)))
MsgBox "「冷蔵庫」の売上の合計は: " & result
' 2列の「売上」の合計を求める。9で合計

result = WorksheetFunction.Subtotal(3, Columns(3)) - 1
MsgBox "「冷蔵庫」のデータ数は: " & result
' 「リンゴ」のデータ数を求める。3でデータ数
' 下の行にデータが無いなら、合計範囲の指定は列全体でもいいが、タイトル行の数も入ってしまうので-1しておく
```
### オートフィルタで絞り込んだ行のみに対して、背景色変更、行削除などを実行
```
Cells(2, 2).AutoFilter 2, "ぶどう"  'フィルタをかける

With Cells(2, 2).CurrentRegion.Offset(1, 0)
  .Resize(.Rows.Count - 1).Interior.Color = RGB(0, 255, 0)
  'フィルタで絞り込まれた行のみを緑背景に
End With

ActiveSheet.ShowAllData  'フィルタ解除

Cells(2, 2).AutoFilter 2, "桃"

With Cells(2, 2).CurrentRegion.Offset(1, 0)
  .Resize(.Rows.Count - 1).EntireRow.Delete
  'フィルタで絞り込まれた行のみを削除
End With
```
### オートフィルタの絞りこみの状態、絞込みの条件等を調べる
```
Cells(2, 2).AutoFilter 2, "桃"

If ActiveSheet.AutoFilterMode = True Then  'オートフィルタが設定されているか
  Debug.Print "設定されています"
Else
  Debug.Print "設定されていません"
End If

If ActiveSheet.FilterMode = True Then  'オートフィルタで絞り込まれているか
  Debug.Print "絞込みされている"
Else
  Debug.Print "絞込み無し"
End If

ActiveSheet.ShowAllData  'フィルタ解除

If ActiveSheet.FilterMode = True Then  'オートフィルタで絞り込まれているか
  Debug.Print "絞込みされている"
Else
  Debug.Print "絞込み無し"
End If

Cells(2, 2).AutoFilter 2, "スイカ"
Cells(2, 2).AutoFilter 3, ">2022/1/15"  '2つの条件で絞り込む

Dim i As Long

With ActiveSheet
  For i = 1 To .AutoFilter.Filters.Count
    Debug.Print i & "列目のタイトルは： " & .AutoFilter.Range(i)  '表のタイトル部分のセル値を取得できる

    If .AutoFilter.Filters(i).On = True Then  'その列で絞込みされている場合
      Debug.Print i & "列目のフィルタリング有り"
    Else
      Debug.Print i & "列目のフィルタリング無し"
    End If
  Next i
End With

ActiveSheet.ShowAllData  'フィルタ解除

Cells(2, 2).AutoFilter 4, "=23000", xlOr, "<10000"

Debug.Print ActiveSheet.AutoFilter.Filters(4).Criteria1
'4列目の、1番目の絞り込み条件を取得　結果は =23000

Debug.Print ActiveSheet.AutoFilter.Filters(4).Criteria2
'4列目の、2番目の絞り込み条件を取得　結果は <10000

'Debug.Print ActiveSheet.AutoFilter.Filters(4).Criteria3
'3番目の条件は無いので、これはエラーになる
```
### 全てのシートの名前を取得する(グラフシート含む)
```
Dim ws As Worksheet
Dim var1 As Variant
Dim cs As Chart

For Each ws In Worksheets   ' 全ワークシートの名前を取得。グラフシートは含まない
  Debug.Print ws.Name
Next ws

For Each var1 In Sheets   ' 全シートの名前を取得。グラフシートも含む
  Debug.Print var1.Name
Next var1

For Each cs In Charts      ' グラフシートのみを対称にするなら、これくらいかな
  Debug.Print cs.Name
Next cs
```
### 複数のシートを選択する
```
Sheets(Array("111", "222", "333")).Select
'シート名での指定だが、「WorkSheets(シート名)」の形ではないらしい

'※リンク先の情報では、シート名ではなくシートのコード名(Sheet1 など)で指定するとなっているが、
'Sheets(Array("Sheet1")).Select としてもエラーになってしまう。バージョンによる?　とりあえず2016では上のコードで

Sheets(Array(シート1.Name, シート2.Name, シート3.Name)).Select
'シート1、シート2、シート3はシートのオブジェクト名。
'シート名では変更される可能性があるので、これが一番確実かも
```
### 選択している全シート名を取得する
```
Sheets(Array("ブック", "設定", "その他")).Select
' "ブック", "設定", "その他" シートを選択

Dim ws As Worksheet
For Each ws In ActiveWindow.SelectedSheets  ' 選択しているシートを取得
  Debug.Print ws.Name
Next ws
```
### シート名についての注意
```
Worksheets.Add(After:=Worksheets(Sheets.Count)).Name = "sheetX"   ' シート「sheetX」を追加

Worksheets.Add(After:=Worksheets(Sheets.Count)).Name = "SHEETX"
' シート「SHEETX」を追加。しかし「この名前はすでに使われています」というエラーメッセージが出て追加できない
' これはシート名は、大文字と小文字を区別しないため。"sheetX"と"SHEETX"は同じものと解釈されてしまうので注意
```
### データのソート
```
' A～D列にデータがあり、1行目はタイトル行とする場合


' ※Excel2007以降で使えるやり方。パラメータの種類･設定値・既定値はリンク先参照

ActiveSheet.Sort.SortFields.Clear
' 現在のソート条件をクリア。これをしないと、現在の条件に新しい条件を追加する形になる
' これを実行すると、手作業でソートをした場合の条件もクリアされた状態になる

ActiveSheet.Sort.SortFields.Add Key:=Range("B1"), SortOn:=xlSortOnValues, Order:=xlAscending
' ソート条件設定。D列でソート、セルの値でソート、昇順でソート　の条件


' 以下、ソート実行のためのコード
With ActiveSheet.Sort
  .SetRange Range("A1:D13")       ' データのある範囲
  .Header = xlYes                 ' 1行目をタイトル行とするか。今回はタイトル行と解釈する
  .MatchCase = False              ' 大文字と小文字を区別するか。文字列でソートならTrueにすべき
  .Orientation = xlTopToBottom    ' 並べ替えの方向。xlTopToBottom で普通に上下方向に並べ替え
  .SortMethod = xlPinYin          ' 日本語をふりがなで並べ替え。xlStroke にすると、文字コードで並べ替え
  .Apply    ' ソートを実行
End With


' 普通に、値・昇順ソートをするなら以下のように
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Key:=Range("A1")

With ActiveSheet.Sort
  .SetRange Range("A1:D13")   ' タイトル行も含めた、データの範囲を指定
  .Apply
End With


'複数の条件を指定する
With ActiveSheet.Sort
  .SortFields.Clear
  .SetRange Range("A1:D21")
  .SortFields.Add Key:=Range("B1"), SortOn:=xlSortOnValues, Order:=xlAscending
  .SortFields.Add Key:=Range("C1"), SortOn:=xlSortOnValues, Order:=xlDescending
  '2番目の条件を指定。C列で降順
  .MatchCase = True
  .Apply
End With


' ※Excel2003までの方法
' ソート条件のクリアというものはないらしい。設定しない条件は、以前の条件が引き継がれるので、なるべく設定すべき

Range("A1:D13").Sort _
  Key1:=Range("B1"), Key2:=Range("D1"), Header:=xlYes, _
  Order1:=xlDescending, Order2:=xlAscending, MatchCase:=True
    
' データ範囲"A1:D13"、第1キーB列、第2キーD列、1行目をタイトルと解釈
'第1キーは降順、第2キーは昇順、大文字小文字は区別　でソート
```
### シートの保護
```
With ActiveSheet
  .Protect      ' シートに保護設定
  .Unprotect    ' シート保護解除

  .Protect Password:="pass01"     ' シートにパスワード付きで保護設定
  .Unprotect Password:="pass01"     ' パスワード付きで保護設定されているシートの保護解除

  .Protect
  ' .Cells(1, 1).Value = "ABC"   ' 保護しているシートなので、セルの値は変えられない。このコードはエラーになる
  .Unprotect
  
  .Protect UserInterfaceOnly:=True  ' マクロでの操作を可能にして、保護をかける
  .Cells(1, 1).Value = "ABC"        ' これでセルの値を変更できる
End With


Workbooks.Open Filename:="aaa.xlsx"
ActiveWorkbook.Worksheets(1).Protect UserInterfaceOnly:=True  ' マクロでの操作を可能にして、保護をかける
ActiveWorkbook.Worksheets(1).Cells(1, 1).Value = "ABC"       ' これはエラーにならないのだが

ActiveWorkbook.Save
ActiveWorkbook.Close    ' 一度閉じて

Workbooks.Open Filename:="aaa.xlsx"
' ActiveWorkbook.Worksheets(1).Cells(1, 1).Value = "ABC"
' もう一度同ブックを開くと、マクロからの操作を受け付けなくなっている(エラーになる)

ActiveWorkbook.Worksheets(1).Protect UserInterfaceOnly:=True  ' もう一度マクロでの操作を可能にして、保護をかければOK
ActiveWorkbook.Worksheets(1).Cells(1, 1).Value = "HJK"     ' これならエラーにならない
```
### マクロでしかシートを再表示できないようにする
```
Worksheets.Add After:=Worksheets(Sheets.Count)
ActiveSheet.Name = "Hidden"

Worksheets("Hidden").Visible = xlVeryHidden    ' マクロからしかシートを再表示できないように設定し、非表示にする

Worksheets("Hidden").Visible = xlSheetVisible    ' 再表示する
    
'***  VBEで、シートのプロパティウィンドウから、Visibleの値を2に変更してもいい
```
### シートのコードの宣言部に記述した変数の値について　シートを切り替えても値を保持するらしい
```
Option Explicit

Dim long1 As Long
Dim long2 As Long

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  long1 = long1 + 10
  long2 = long2 + 100
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Debug.Print "long1: " & long1
  Debug.Print "long2: " & long2
End Sub

'選択範囲を変更した時に、long1とlong2の値を出力
'ダブルクリック時に、long1とlong2の値を増加させている
'このシートを非アクティブにして、再びアクティブにした時は、long1とlong2は前の値を保持している
'通常の変数に限らず、オブジェクト型やクラスのインスタンスも保持するらしい
```
### シートのコードで、グローバル変数や通常のプロシージャを設定する
```
Option Explicit

Private currentRange As Range
'シートのコード内で使えるグローバル変数。現在選択されているセル範囲を格納
Private long1 As Long

'グローバル変数の内容は、ブックが閉じられるまでは保持されるようだ


Private Sub Worksheet_Activate()
  If currentRange Is Nothing Then  'まだcurrentRangeがSetされていない場合
    Set currentRange = Me.Range("A1") ' シートのコードでは、Meはこのシートになる
    Me.Cells.Interior.ColorIndex = 0  'シート全体の背景色を無色に
    long1 = 100
  End If

End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)   '選択範囲が変更された時の処理
  currentRange.Interior.ColorIndex = 0  'currentRangeの範囲の背景色を無色に
  Set currentRange = Target        '新しく選択された範囲をcurrentRangeにSet
  Target.Interior.ColorIndex = 6   '新しく選択された範囲を黄色に
  
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)  'シートに変更(多分セルの値の変更)があった時
  long1 = long1 + 200
  Call Tekitou  'シートのコード内でも通常のプロシージャは使える
End Sub

Private Sub Tekitou()
  MsgBox "long1の値：" & long1
End Sub
```
### オートフィルタでデータの絞込み、絞込みの解除。絞込みの条件指定や、日付での指定方法など
```
フィルタに関してはここに大体まとめた　　VBAサンプルブックとして、「オートフィルタ検証.xlsm」というものを作成してある

Sub AAA()  '*******　　絞込みの解除  **************
  
  If ActiveSheet.FilterMode = True Then   ' オートフィルタでデータの絞込みがされている場合
    ActiveSheet.ShowAllData
    ' データの絞込みを解除。フィルタそのものを解除ではなく、絞込み無しにして全てのデータを表示している状態に
  End If
  
  
  If ActiveSheet.FilterMode = True Then
    ActiveSheet.AutoFilterMode = False    ' これはオートフィルタそのものを解除してしまう
  End If
  
End Sub



Sub BBB()  '**********   条件を指定して絞り込む   ***************

Cells(2, 2).AutoFilter Field:=2, Criteria1:="オレンジ"
' セルB2を含む有効セル範囲で、左から2番目の列を "=オレンジ" の条件でフィルタリングする
' オートフィルタが未設定の場合は設定される

'Range("B2").AutoFilter Field:=2, Criteria1:="オレンジ"  この表記でもいい

Cells(2, 2).AutoFilter 2, "オレンジ"
' このように省略できる。上と同じ処理になる




Cells(2, 2).AutoFilter 3, "<>家電"   'これは「家電に一致しない」という条件
Range("B2").AutoFilter 2, "<>"         'これは「空白ではない」という条件
Range("B2").AutoFilter 2, ""           'これは「空白」という条件
Range("B2").AutoFilter 2, "*麦"         ' * でワイルドカードも使える。「小麦」・「大麦」等がヒット
Range("B2").AutoFilter 2, "~*~?AA"
'*?を条件に含める場合は、半角チルダでエスケープする・「*?AA」というセルがヒット

Range("B2").AutoFilter 2, "==AA"
'=<>を条件に含める場合は、=でエスケープする。半角チルダでは駄目。「=AA」がヒット

Range("B2").AutoFilter 2, " リンゴ "
'セルの文字列の前後にあるに半角スペースは無視されるらしい。条件に入れても無視されるみたい
Range("B2").AutoFilter 2, "リン  ゴ"    'この場合は、スペースは無視されない

Range("B2").AutoFilter 2, "リンゴ"
Range("B2").AutoFilter 5, ">=10000"
' 複数の列に条件を指定。第2列 = "リンゴ"  AND  第5列 >=10000   の条件になる

Range("B2").AutoFilter Field:=2, Criteria1:="小麦", Operator:=xlOr, Criteria2:="ぶどう"
' 1列に複数の条件を設定。第2列 = "小麦"  OR  第2列 = "ぶどう" の条件になる
Range("B2").AutoFilter 2, "小麦", xlOr, "ぶどう"   '省略形も可能


Range("B2").AutoFilter 5, ">=15000", xlAnd, "<=55000"
' こちらは第5列の値が 15000以上かつ55000以下　の条件になる


Range("B2").AutoFilter Field:=2, Criteria1:=Array("リンゴ", "ぶどう", "キャベツ"), Operator:=xlFilterValues
' Excel2007以降限定で、Operator:=xlFilterValues とすることで1列に3つ以上の条件を設定できる

'Range("B2").AutoFilter Field:=1, Criteria1:="リンゴ", Criteria2:="ぶどう", Criteria3:="キャベツ", Operator:=xlFilterValues
'※この表記は不可

Range("B2").AutoFilter 2, "*麦"   ' ワイルドカード指定も可能。
Range("B2").AutoFilter 2, "???"   ' 任意の3文字


Cells(2, 2).AutoFilter Field:=2, Criteria1:="洗濯機"
Cells(2, 2).CurrentRegion.SpecialCells(xlCellTypeVisible).Copy Cells(10009, 2)
' データの絞込みで抽出されたセルのみをコピーし、セルB25に貼り付ける(可視セルのみをコピーすることで実現している)
'　※Excel2002以降は、可視セルに限定しなくてもいけるらしい

Cells(2, 2).AutoFilter Field:=2, Criteria1:="麦茶"
Cells(2, 2).CurrentRegion.Copy Cells(10009, 2)
'Excel2016はこれでもOK
    
    
  
'**********  数値での条件設定  **********
'大小比較
Cells(2, 11).AutoFilter 1, ">50000"  'セルの書式が通常の数値であれば、値で比較できる
Cells(2, 11).AutoFilter 2, ">40000"  'セルの書式が「100,000」のように3桁区切りでも、値で比較できるらしい
Cells(2, 11).AutoFilter 3, ">60000"  'セルの書式が「\100,000」のように通貨形式でも、値で比較できるらしい
Cells(2, 11).AutoFilter 4, ">12000"  'セルの書式が「00000円」のようにユーザー定義でも、値で比較できるらしい

'等しいという条件。これは注意が必要
Cells(2, 11).AutoFilter 1, "=5000"    'セルの書式が通常の数値であれば、値で比較できる
Cells(2, 11).AutoFilter 2, "=5000"    'セルの書式が「100,000」のように3桁区切りだと、=条件ではヒットしない
Cells(2, 11).AutoFilter 2, "=5,000"   'これはヒットする。区切りの「,」が必要になる
Cells(2, 11).AutoFilter 3, "=5000"    'セルの書式が「\100,000」のように通貨形式だと、=条件ではヒットしない
Cells(2, 11).AutoFilter 3, "=\5,000"  'これはヒットする。区切りの「,」と「\」が必要になる
Cells(2, 11).AutoFilter 4, "=5000"    'セルの書式が「00000円」のようにユーザー定義だと、=条件ではヒットしない
Cells(2, 11).AutoFilter 4, "=05000"    'これもヒットしない
Cells(2, 11).AutoFilter 4, "=05000円"  'これはヒットする。「円」が必要になる

End Sub


Sub CCC()  '********　日付での絞りこみ    *************


Cells(2, 11).AutoFilter 6, ">=2022/1/1"
'日付でも大小比較の指定は可能らしい

Cells(2, 11).AutoFilter 6, ">=2020/1/5", xlAnd, "<=2020/3/5"
'これも可能



'※以下は少し難しい

Cells(2, 11).AutoFilter 6, "2020/1/1"
' Excelのバージョンは2016、セルの書式設定は「標準」「日付」「文字列」の場合、この表記で絞込みできる

' ※日付での絞り込みは、エクセルのバージョンやセルの書式設定によって、絞込みの可否や結果が変わるらしい
' 詳しくはリンク先を参照。日付で絞込みは、単純な形式のみにしたほうがよさそう



' ※Excel2007以降限定、セルの書式設定「標準」「日付」の場合、以下のような絞込みが可能

Cells(2, 2).AutoFilter Field:=6, Operator:=xlFilterValues, _
  Criteria2:=Array(1, "2020/1/1", 1, "2020/2/3", 1, "2020/3/5")
' Criteria1:= ではなく、 Criteria2:= であることに注意
' 1, "2020/1/1"  の1は、「月」を指定している。
' "2020/1/1"の月なので、2020年の1月のデータを条件にしていることになる(1日は無関係)
' 上の場合は、2020年の1月・2月・3月のデータのみを絞り込むことになる。何日であるかは無視する

Cells(2, 2).AutoFilter Field:=6, Operator:=xlFilterValues, _
Criteria2:=Array(2, "2021/1/1", 2, "2021/2/3", 2, "2021/3/5")
' 2は「日」を指定するので、この場合は"2021/1/1"・"2021/2/3"・"2021/3/5"の3日分のデータのみを絞り込む

Range("B2").AutoFilter Field:=6, Operator:=xlFilterValues, _
Criteria2:=Array(0, "2019/1/1", 0, "2020/2/3", 0, "2022/3/5")
' 0は「年」を指定するので、この場合は2019年・2020年・2022年のデータで絞り込む

End Sub
```
### オートフィルタで、特定の条件で絞込みをしたデータ範囲を、Variant型配列へ格納する
```
意外と面倒な話　　VBAサンプルブックとして、「オートフィルタ検証.xlsm」というものを作成してある

Sub GGG()
  Dim var1 As Variant

  Worksheets("データ4").Cells.Clear
  
  Worksheets("データ5").Activate
  Worksheets("データ5").Range(Cells(2, 2), Cells(32, 5)).Copy
  
  Worksheets("データ4").Activate
  Worksheets("データ4").Cells(2, 2).Select
  Worksheets("データ4").Paste
  
  Cells(2, 2).AutoFilter 2, "スイカ"  'フィルタをかける

  Cells(2, 2).CurrentRegion.Offset(1, 0).Resize(Cells(2, 2).CurrentRegion.Offset(1, 0).Rows.Count - 1).Select
  var1 = Selection.Value  'これは全データが格納されてしまい、フィルタリングの意味が無い

  Cells(2, 2).CurrentRegion.Offset(1, 0).Resize(Cells(2, 2).CurrentRegion.Offset(1, 0).Rows.Count - 1).SpecialCells(xlCellTypeVisible).Select
  var1 = Selection.Value
  'これは、データ部分の1行目から、非表示になっている最初の行の手前までしか選択されない
  
  Selection.Copy  '絞り込んだ状態の範囲をコピー
  Cells(35, 2).Select
  Worksheets("データ4").Paste  '別のセルへ貼り付けする
  var1 = Selection.Value
  'こうすると、var1にはフィルタリングした範囲の値が格納される。結構面倒だな
  
Stop
End Sub
```