Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

51670 / 76738

←次へ　｜　前へ→


	【29931】Re:オートフィルタ

とまと - 05/10/16(日) 20:58 -


	引用なし

	パスワード

みなさん最後まで作成されてるようなので
わたしも(^^
★★★.xlsのsheet2に貼り付けています。
適宜変更してみてください。

Sub test3()

Dim i　As Long
Dim st As String
Dim sh2 As Worksheet
Set sh2 = Workbooks("★★★.xls").Worksheets("sheet2")　'適宜変更
sh2.Cells.Clear

Application.ScreenUpdating = False
　　With Sheets(wsn)
　　　st = .Range("B2").NumberFormatLocal
　　　開始年月日 = Format(DateSerial(2005, 7, 1), st)
　　　終了年月日 = Format(DateSerial(2005, 8, 1 - 1), st)
　　　.Columns("F").Clear
　　　 rowA = .Range("A1").CurrentRegion.Rows.Count
　　　For i = 2 To 5
　　　　 .AutoFilterMode = False
　　　　 .Range("A1:F" & rowA).AutoFilter i, ">=" & 開始年月日, xlAnd, "<=" & 終了年月日
　　　　 .AutoFilter.Range.Columns(6).Value = 1
　　　Next i
　　　.AutoFilterMode = False
　　　.Range("F1").Value = "作業列"
　　　.Range("A1").AutoFilter 6, 1
　　　.Range("A1").CurrentRegion.Copy sh2.Range("a1")
　　　.AutoFilterMode = False
　　　.Columns(6).Clear
　　　 sh2.Columns(6).Clear
　　End With
Application.ScreenUpdating = True

End Sub

0 hits

▼

【29897】オートフィルタ ハッチ 05/10/15(土) 21:06