| |
▼yasu さん 今日は
これでできるとおもいます。
>
>ご解答ありがとうございます。
>これからエクセルに貼り付け操作させていただきます。
>E1にデータを入れなくて良いのですか！
>ありがとうございました。
>>別解ですが参考にしてください。
>>E1にデータ入れなくてもよくなっています。
>
>kobasan さん。少し時間を割いていただけませんでしょうか。
>何とか私なりに、仕上げたのですが。
>上書きが出来ない欠点があります。
>２回マクロを使うとエラーになります。
>私のコードを見ていただき、コードの訂正をしていただけませんでしょうか。
>不躾なお願いをお許しください。
>
>時間が有りましたら、是非よろしくお願いします。
>
>Sub 売上氏名単位集計()
>
> Dim i As Integer
> Dim St_Name As String
> Dim シート数 As Integer
> シート数 = Sheets.Count
>
> Sheets("売上一覧").Select '対象種類を絞り込む
> Range("B2", Cells(65536, 2).End(xlUp)).Select
> Selection.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
> Selection.SpecialCells(xlCellTypeVisible).Copy
> Range("Z3000").Select
> ActiveSheet.Paste
> Application.CutCopyMode = False
>
> Range("A1").Select
>
> For i = Cells(65536, 26).End(xlUp).Row To 3001 Step -1
> Range("E1") = Cells(i, 26).Value '絞り込んだ対象を順次明示
> St_Name = Range("E1")
del_sheet St_Name '<=======追加
>
> Sheets("売上一覧").Activate
> Range("A2").AutoFilter Field:=2, Criteria1:=Range("E1")
> Range("A2").CurrentRegion.Select
> Selection.Copy
Sheets.Add before:=Sheets(シート数 - 1) '<=======修正
Sheets(シート数 - 1).Name = St_Name '<=======修正
>
> Range("A2").Select
> ActiveSheet.Paste
> Application.CutCopyMode = False
> Sheets("売上一覧").Activate
> Selection.AutoFilter
>' Range("A1").Select
>'
> Next
>
> Range("A1").Select
>End Sub
'============以下追加
Sub del_sheet(St_Name As String)
On Error Resume Next
Application.DisplayAlerts = False
Sheets(St_Name).Delete
On Error GoTo 0
Application.DisplayAlerts = True
End Sub
|
|
kobasan
- 05/7/2(土) 16:11 -
