| |
▼kobasan さん：
今晩は。
>Range("J1").Valueを参照しないようにしました。
kobasanの作成された方が、質問者の希望に合っているかも知れませんね。
よく分かりました。合計もできてよいですね。
私もじっくりと勉強させていただきたいと思います。
商品の検出・格納はどこでしているのでしょうか？
>Sub 絞込みコピー貼付()
>Dim c As Range
>Dim X() As Variant
> Application.ScreenUpdating = False
> Sheets(2).Cells().ClearContents
> '-----タイトル行をコピー・貼付
> With Sheets(1)
> .Range("A1", .Cells(1, 200).End(xlToLeft)).Copy
> End With
> Sheets(2).Cells(1, 1).PasteSpecial Paste:=xlValues
> '-----品名の無重複データ作成
> With Sheets(1)
> n = 0
> For Each c In Range("B2", Sheets(1).Cells(65535, 2).End(xlUp))
> If Application.CountIf(.Range("B2", c), c.Value) = 1 Then
> n = n + 1
> ReDim Preserve X(1 To n)
> X(n) = c.Value
> End If
> Next
> End With
> '-----抽出・コピー・貼付
> For i = 1 To UBound(X)
> '-----抽出・コピー
> Sheets(1).Select
> Range("A1").Select
> Selection.AutoFilter Field:=2, Criteria1:=X(i)
> Selection.CurrentRegion.Offset(1).Copy
> '-----貼付
> Sheets(2).Cells(65536, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
> '-----AutoFilterを解除
> Sheets(1).Select
> Range("A1").Select
> Selection.AutoFilter
> '-----小計を格納
> Sheets(2).Select
> With Sheets(2).Cells(65535, 1).End(xlUp)
> .Offset(1, 0) = Trim(X(i)) & "計"
> .Offset(1, 3) = Application.WorksheetFunction.Sum(Selection.Columns(4))
> .Offset(1, 4) = Application.WorksheetFunction.Sum(Selection.Columns(5))
> .Offset(1, 5) = Application.WorksheetFunction.Sum(Selection.Columns(6))
> End With
> Next
> '-----合計を格納
> Sheets(2).Select
> With Sheets(2).Cells(65535, 1).End(xlUp)
> .Offset(1, 0) = "合 計"
> .Offset(1, 3) = Application.WorksheetFunction.Sum(Sheets(1).Columns(4))
> .Offset(1, 4) = Application.WorksheetFunction.Sum(Sheets(1).Columns(5))
> .Offset(1, 5) = Application.WorksheetFunction.Sum(Sheets(1).Columns(6))
> End With
>End Sub
|
|
YN61
- 05/4/10(日) 23:18 -
