Excel VBA質問箱 IV

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

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


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

4559 / 76807

←次へ　｜　前へ→


	【77870】Re:オートフィルターの絞込列と抽出結果のコピペ列をずらしながらの繰り返し処理

β - 16/1/16(土) 8:35 -


	引用なし

	パスワード

▼綾香さん：

データが膨大なので、テストデータをつくるのもおっくうで、検証していません。
書きなぐっただけです。膨大な表なので、それなりに処理時間はかかると思います。

Sub Test()
　　Dim shD As Worksheet
　　Dim shF As Worksheet
　　Dim r As Range
　　
　　Dim dest As Long
　　Dim flg As Long
　　Dim sls As Long
　　
　　Application.ScreenUpdating = False
　　
　　Set shD = Sheets("Data")
　　Set shF = Sheets("Filter")
　　
　　shF.UsedRange.ClearContents
　　shD.AutoFilterMode = False
　　
　　shD.UsedRange.Columns("A:RE").AutoFilter
　　Set r = shD.AutoFilter.Range
　　
　　dest = Columns("A").Column
　　sls = Columns("FL").Column
　　
　　For flg = Columns("NH").Column To Columns("RE").Column
　　
　　　　r.AutoFilter field:=flg, Criteria1:="ON"
　　　　If r.Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
　　　　　　r.Columns("D").Copy shF.Cells(1, dest)
　　　　　　r.Columns("G").Copy shF.Cells(1, dest + 1)
　　　　　　r.Columns("J").Copy shF.Cells(1, dest + 2)
　　　　　　r.Columns(sls).Copy shF.Cells(1, dest + 3)
　　　　End If
　　　　
　　　　shD.ShowAllData
　　　　dest = dest + 5
　　　　sls = sls + 1
　　　　
　　Next
　　
　　shD.AutoFilterMode = False
　　shF.Select
　　
End Sub

0 hits

▼

【77868】オートフィルターの絞込列と抽出結果のコピペ列をずらしながらの繰り返し処... 綾香 16/1/16(土) 0:26