Excel VBA質問箱 IV

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

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


7606 / 13646 ツリー ←次へ | 前へ→

【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 -

引用なし
パスワード
   ありがとうございます。

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


▼ハチ さん:
>▼サン さん:
>
>>1-400の範囲は、本当はデータを全て消したいのですが
>>全て範囲指定していましたら、マクロを走らせた時に
>>時間がとてもかかっていたので400ぐらいでいいかなと思い
>>400にしてしまいました。
>
>時間がかかったのは、やたらとSelectしているからで
>行数が多いからではないと思います。
>
>全部削除で良いのなら
>>>    With ws.Rows("1:400")
>>>      .ClearContents
>>>      .Interior.ColorIndex = xlNone
>>>    End With
>の部分を ws.UsedRange.Delete
>
>で良いと思います。

7606 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free