【ExcelVBA】入力された日付から１週間分データ処理するマクロを考えていますがうまくいきません。

入力した日付から１週間分データ処理する作業をしているのですが、いつも同じところでエラーが出てしまいます。For文を使用せず１日分の処理であればうまくいくのですがオートフィルの解除方法が間違えているのでしょうか・・・どなたか詳しい方教えていただきたいです。

Private Sub cmd実行_Click()


If IsDate(txt日付.Value) = False Then

MsgBox "日付を「2019/10/01」のように入力してください"
txt日付.Value = ""

Exit Sub
End If


Dim Date_select As Date
Date_select = txt日付.Value '入力した日付をDate_select に格納
MsgBox Date_select



Dim fName As String
fName = Application.GetOpenFilename(FileFilter:="Excelブック,*.xlsx*", MultiSelect:=False)

If fName = "False" Then
MsgBox "キャンセルしました。"
Exit Sub '終了
End If

Dim wb As Workbook
Set wb = Workbooks.Open(fName)

'-------- ここ以降に、wbに対する処理を書く --------

Unload Me 'フォームを閉じる

wb.Sheets(1).Range("A2：CD2").AutoFilter '全体にフィルターをかける

Dim MaxGyou As Long '全体の行数をカウント H3から数える←空白がない列だから
MaxGyou = wb.Sheets(1).Range("H3").End(xlDown).Row
'MsgBox "行数は、" & MaxGyou & "件です。", vbInformation



Dim FoundCell As Range '入力した日付と一致する日付があるかどうか判断する
Set FoundCell = wb.Sheets(1).Range("I2:I" & MaxGyou). _
CurrentRegion.Find(What:=Date_select)
If FoundCell Is Nothing Then
MsgBox "入力したデータはありません"
Else

Dim X As Integer

For X = 0 To 6 '1週間分データ処理


Select Case X

Case 1, 2, 3, 4, 5, 6
'2回目以降オートフィルター一旦解除
wb.Sheets(1).Range("A2：CD2").AutoFilter '全体のフィルターを一旦解除

Case Else
'何もしない
End Select

'取得した日付で絞込
wb.Sheets(1).Range("I2").AutoFilter 9, Format(Date_select + X, wb.Sheets(1).Range("I3").NumberFormatLocal)



Dim Input_date_count As Long '入力された日付で絞られた行数をとりあえずカウント
Input_date_count = WorksheetFunction.CountIf(Range("I3:I" & MaxGyou), Date_select + X)
'MsgBox "入力された日付の行数は、" & Input_date_count & "件です。", vbInformation



Select Case X

Case 0 '列の非表示は最初のみ


'連続しない（隣接しない）列の選択と非表示
'列番号A～H、S、AP～AR、BE～CDを非表示
Application.Union(wb.Sheets(1).Range("A:H"), wb.Sheets(1).Range("S:S"), wb.Sheets(1).Range("AP:AR"), _
wb.Sheets(1).Range("BE:CD")).EntireColumn.Hidden = True



Case Else
'何もしない
End Select



With wb.Sheets(1)
.Sort.SortFields.Clear




'優先列1 日付　昇順
.Sort.SortFields.Add _
Key:=wb.Sheets(1).Cells(2, 9), _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal

'優先列2 名称　昇順
.Sort.SortFields.Add _
Key:=wb.Sheets(1).Cells(2, 13), _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal

'優先列3 時刻　昇順
.Sort.SortFields.Add _
Key:=wb.Sheets(1).Cells(2, 10), _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal

With .Sort
.SetRange wb.Sheets(1).Range(Cells(2, 1), Cells(MaxGyou, 82)) '全件数と82列までが範囲　　←　いつもここでエラー
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply

End With
・
　・
　　・

No.4 回答者： WindFaller 回答日時： 2019/10/10 16:33

読んだだけで、あっているかどうかはわかりませんが、気になる点があります。

With wb.Sheets(1)
　　With .Sort　'←ここは取らない
'浮いている部分がある
.SetRange wb.Sheets(1).Range(Cells(2, 1), Cells(MaxGyou, 82)) '全件数と82列までが範囲
　　End With
End With

エラーがでるかでないかよりも、その部分は、
　Cells(2, 1), Cells(MaxGyou, 82)
ここが浮いています。

With wb.Sheets(1)　'こんな書き方になる
　.Sort.SetRange wb.Sheets(1).Range(.Cells(2, 1), .Cells(MaxGyou, 82))
End With

とすると、上のWith wb.Sheets(1)と繋がります。
-------------
MaxGyou = wb.Sheets(1).Range("H3").End(xlDown).Row
ふつうは、ここも、 Cells(Rows.Count, "H").End(xlUp).Row　で最後尾を取ります。

No.3 回答者： めぐみん_ 回答日時： 2019/10/10 16:22

No.1~2です。

＞.SetRange wb.Sheets(1).Range(Cells(2, 1), Cells(MaxGyou, 82))'全件数と82列までが範囲　　←　いつもここでエラー

ここで良いのかな？

Rangeに対しては wb.Sheets(1)のセルである事を示せてますが、中の Cellsに対してはActiveになっているシートのセルを指してます。
なので明確にしてあげるため、

.SetRange wb.Sheets(1).Range(wb.Sheets(1).Cells(2, 1), wb.Sheets(1).Cells(MaxGyou, 82))

とするべきと思いますよ。

・・・・

Input_date_count = WorksheetFunction.CountIf(Range("I3:I" & MaxGyou), Date_select + X)

ここのRangeはActiveなのかwb.Sheets(1)なのか・・・？
他も注意して見直してみて下さい。

No.2 回答者： めぐみん_ 回答日時： 2019/10/10 16:10

No.1です。

ついでに　SELECT CASE　で　CASE　が連続するある範囲の場合なら、
https://excel-ubara.com/excelvba1/EXCELVBA322.html

Case 1 To 6

でもいけるかと。

No.1 回答者： めぐみん_ 回答日時： 2019/10/10 16:06

スマホでチラって見ただけですのでまだ見落としがあるかもですが。

Case 1, 2, 3, 4, 5, 6
'2回目以降オートフィルター一旦解除
wb.Sheets(1).Range("A2：CD2").AutoFilter '全体のフィルターを一旦解除

これがコピペで貼り付けたコードであるなら、

Case 1, 2, 3, 4, 5, 6
'2回目以降オートフィルター一旦解除
wb.Sheets(1).Range("A2:CD2").AutoFilter '全体のフィルターを一旦解除

とセル範囲を示す":"が全角文字の"："になってた点ですかね。

この回答へのお礼

確認ありがとうございます。もう一度半角で入力し直してみたのですが、２回目以降←エラーのところでとまってしまいます。

お礼日時：2019/10/10 16:11