Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
7604 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【37959】下のマクロを実行すると固まってしまいます。 サン 06/5/24(水) 10:48 質問[未読]
【37962】Re:下のマクロを実行すると固まってしま... ハチ 06/5/24(水) 12:15 回答[未読]
【37963】Re:下のマクロを実行すると固まってしま... サン 06/5/24(水) 12:26 お礼[未読]
【37989】Re:下のマクロを実行すると固まってしま... ハチ 06/5/24(水) 17:53 発言[未読]
【38014】Re:下のマクロを実行すると固まってしま... サン 06/5/25(木) 9:20 お礼[未読]
【37959】下のマクロを実行すると固まってしまいま...
質問  サン E-MAIL  - 06/5/24(水) 10:48 -
引用なし
パスワード
   下記のマクロをもう少し簡単にすること出来ますでしょうか。

Sub 担当者別()
'
' 担当者別 Macro
' 未収入金　販売
'

'
　　Sheets(Array("○", "×", "丸々", "★", "星", "■", "♪")).Select
　　Sheets("○").Activate
　　Rows("1:400").Select
　　Selection.Interior.ColorIndex = xlNone
　　Selection.ClearContents
　　Range("A2").Select
　　Sheets("販売").Select
　　Selection.AutoFilter
　　Selection.AutoFilter Field:=12, Criteria1:="○"
　　Cells.Select
　　Range("F1").Activate
　　Selection.Copy
　　Sheets("○").Select
　　Range("A1").Select
　　ActiveSheet.Paste
　　Application.CutCopyMode = False
　　Sheets("販売").Select
　　Selection.AutoFilter Field:=12, Criteria1:="×"
　　Selection.Copy
　　Sheets("×").Select
　　Range("A1").Select
　　ActiveSheet.Paste
　　Application.CutCopyMode = False
　　Range("A1").Select
　　Sheets("○").Select
　　Range("A1").Select
　　Sheets("販売").Select
　　Selection.AutoFilter Field:=12, Criteria1:="丸々"
　　Selection.Copy
　　Sheets("丸々").Select
　　Range("A1").Select
　　ActiveSheet.Paste
　　Application.CutCopyMode = False
　　Range("A1").Select
　　Sheets("販売").Select
　　Selection.AutoFilter Field:=12, Criteria1:="★"
　　Selection.Copy
　　Sheets("★").Select
　　Range("A1").Select
　　ActiveSheet.Paste
　　Application.CutCopyMode = False
　　Range("A1").Select
　　Sheets("販売").Select
　　Selection.AutoFilter Field:=12, Criteria1:="星"
　　Selection.Copy
　　Sheets("星").Select
　　Range("A1").Select
　　ActiveSheet.Paste
　　Application.CutCopyMode = False
　　Range("A1").Select
　　Sheets("販売").Select
　　Selection.AutoFilter Field:=12, Criteria1:="■"
　　Selection.Copy
　　Sheets("■").Select
　　Range("A1").Select
　　ActiveSheet.Paste
　　Application.CutCopyMode = False
　　Range("A1").Select
　　Sheets("販売").Select
　　Selection.AutoFilter Field:=12, Criteria1:="♪"
　　Selection.Copy
　　Sheets("♪").Select
　　Range("A1").Select
　　ActiveSheet.Paste
　　Application.CutCopyMode = False
　　Range("A1").Select
　　Sheets("販売").Select
　　Range("A1").Select
　　
　　Selection.AutoFilter
　　
　　MsgBox "担当者別にしました"
　　
End Sub


宜しくお願い致します。
【37962】Re:下のマクロを実行すると固まってしま...
回答  ハチ  - 06/5/24(水) 12:15 -
引用なし
パスワード
   ▼サン さん：

あんまり良く読んでませんが・・・
販売以外のSheet名で、12列をフィルタするなら
こんな感じでもできると思います。
1:400の行でクリアするのは、セルの色？Fontの色？

Sub test()

Dim ws As Worksheet

For Each ws In Worksheets
　　If ws.Name <> "販売" Then
　　　　With ws.Rows("1:400")
　　　　　　.ClearContents
　　　　　　.Interior.ColorIndex = xlNone
　　　　End With
　　　　
　　　　With Worksheets("販売").Range("A2")
　　　　　　.AutoFilter Field:=12, Criteria1:=ws.Name
　　　　　　.CurrentRegion.SpecialCells(xlCellTypeVisible).Copy ws.Range("A1")
　　　　　　.AutoFilter
　　　　End With
　　End If
Next ws

MsgBox "担当者別にしました"

End Sub
【37963】Re:下のマクロを実行すると固まってしま...
お礼  サン E-MAIL  - 06/5/24(水) 12:26 -
引用なし
パスワード
   ハチ　さん

すいません。
1-400の範囲は、本当はデータを全て消したいのですが
全て範囲指定していましたら、マクロを走らせた時に
時間がとてもかかっていたので400ぐらいでいいかなと思い
400にしてしまいました。

ご迷惑をかけてすいません。
本当にありがとうございます。


▼ハチ さん：
>▼サン さん：
>
>あんまり良く読んでませんが・・・
>販売以外のSheet名で、12列をフィルタするなら
>こんな感じでもできると思います。
>1:400の行でクリアするのは、セルの色？Fontの色？
>
>Sub test()
>
>Dim ws As Worksheet
>
>For Each ws In Worksheets
>　　If ws.Name <> "販売" Then
>　　　　With ws.Rows("1:400")
>　　　　　　.ClearContents
>　　　　　　.Interior.ColorIndex = xlNone
>　　　　End With
>　　　　
>　　　　With Worksheets("販売").Range("A2")
>　　　　　　.AutoFilter Field:=12, Criteria1:=ws.Name
>　　　　　　.CurrentRegion.SpecialCells(xlCellTypeVisible).Copy ws.Range("A1")
>　　　　　　.AutoFilter
>　　　　End With
>　　End If
>Next ws
>
>MsgBox "担当者別にしました"
>
>End Sub
【37989】Re:下のマクロを実行すると固まってしま...
発言  ハチ  - 06/5/24(水) 17:53 -
引用なし
パスワード
   ▼サン さん：

>1-400の範囲は、本当はデータを全て消したいのですが
>全て範囲指定していましたら、マクロを走らせた時に
>時間がとてもかかっていたので400ぐらいでいいかなと思い
>400にしてしまいました。

時間がかかったのは、やたらとSelectしているからで
行数が多いからではないと思います。

全部削除で良いのなら
>>　　　　With ws.Rows("1:400")
>>　　　　　　.ClearContents
>>　　　　　　.Interior.ColorIndex = xlNone
>>　　　　End With
の部分を　ws.UsedRange.Delete

で良いと思います。
【38014】Re:下のマクロを実行すると固まってしま...
お礼  サン E-MAIL  - 06/5/25(木) 9:20 -
引用なし
パスワード
   ありがとうございます。

ＶＢＡを始めたばかりで、色々分からないことが多くて
ご迷惑かけてばかりですいません。


▼ハチ さん：
>▼サン さん：
>
>>1-400の範囲は、本当はデータを全て消したいのですが
>>全て範囲指定していましたら、マクロを走らせた時に
>>時間がとてもかかっていたので400ぐらいでいいかなと思い
>>400にしてしまいました。
>
>時間がかかったのは、やたらとSelectしているからで
>行数が多いからではないと思います。
>
>全部削除で良いのなら
>>>　　　　With ws.Rows("1:400")
>>>　　　　　　.ClearContents
>>>　　　　　　.Interior.ColorIndex = xlNone
>>>　　　　End With
>の部分を　ws.UsedRange.Delete
>
>で良いと思います。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
7604 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free