Excel VBA質問箱 IV

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

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


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

8435 / 76732

←次へ　｜　前へ→


	【73871】Re:コード整理

UO3 - 13/2/26(火) 20:30 -


	引用なし

	パスワード

▼ハクエンさん：

こんばんは

振り分け後、元シートに対してしておられることの意味がいまいち把握できないので
（なんとなくわかるのですが）そこは割愛しています。
必要なら追加してください。

また、抽出がないときの手当はさぼっています。

Sub Sample()
　　Dim myKey As String
　　Dim mySht As String
　　Dim x As Long
　　Dim keyV As Variant
　　Dim shtV As Variant
　　
　　Application.ScreenUpdating = False
　　
　　keyV = Split("1.チームA 2.チームB 3.チームC 4.チームD 5.チームE 6.チームF 7.チームG 8.チームH")
　　shtV = Split("A B C D E F G H")
　　
　　
　　With Sheets("原紙")
　　
　　　　.AutoFilterMode = False
　　　　.Range("A1").AutoFilter
　　　　
　　　　For x = 1 To 8
　　　　　　myKey = keyV(x - 1)
　　　　　　mySht = shtV(x - 1)
　　　　　　
　　　　　　.AutoFilter.Range.AutoFilter Field:=4, Criteria1:=myKey
　　　　　　Sheets(mySht).UsedRange.Clear
　　　　　　.AutoFilter.Range.Copy Sheets(mySht).Range("A1")
　　　　　　With Sheets(mySht).UsedRange
　　　　　　　　.RowHeight = 22.5
　　　　　　　　.Resize(.Rows.Count - 1).Offset(1).Replace What:="" & Chr(10) & "", Replacement:="　", _
　　　　　　　　　　LookAt:=xlPart
　　　　　　End With
　　　　Next
　　　　
　　　　.AutoFilterMode = False
　　　　
　　End With
　　
　　Application.ScreenUpdating = True
　　MsgBox "振り分け完了"
　　
End Sub

287 hits

▼

【73868】コード整理 ハクエン 13/2/26(火) 16:23