Excel VBA質問箱 IV

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

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


53278 / 76732 ←次へ | 前へ→

【28272】Re:とある条件のレコードだけ合計が必要な場合
発言  ponpon  - 05/9/1(木) 20:39 -

引用なし
パスワード
   こんばんは。
確か、前に似たような質問があったような、
ichinoseさんが、回答していたように思います。

私では、
期待には応えられませんが、似たようなことならできます。
中分類をフィルターオプションで抽出し、オートフィルターで処理してます。

シート1がデータシート
シート2が結果シート
データシートのF列を作業列で使用しています。

Sub test()
  
  Dim SH1 As Worksheet
  Dim SH2 As Worksheet
  Dim myR As Range
  Dim myR2 As Range
  Dim myVal As Variant
  
  Set SH1 = Worksheets("sheet1")
  Set SH2 = Worksheets("sheet2")
  Set myR = SH1.Range("A1").CurrentRegion
  Set myR2 = SH1.Range("D2:D" & myR.Rows.Count)
  Application.ScreenUpdating = False
    myR.Columns(2).AdvancedFilter xlFilterCopy, _
            copytorange:=SH1.Range("F1"), unique:=True
    myVal = SH1.Range("F2", SH1.Range("F65536").End(xlUp)).Value
   For i = 1 To UBound(myVal, 1)
    With myR
     .AutoFilter field:=2, Criteria1:=myVal(i, 1)
     .Offset(1, 0).Resize(myR.Rows.Count - 1, myR.Columns.Count).Copy _
      SH2.Range("A65536").End(xlUp).Offset(3, 0)
      
      With SH2.Range("C65536").End(xlUp).Offset(1, 0)
       .Value = "合計"
       .Font.Bold = True
       .Offset(0, 1).Value = Application.Subtotal(9, myR2)
       .Offset(0, 1).Font.Bold = True
      End With
    
     .AutoFilter
    End With
    Next
  SH1.Range("F:F").ClearContents
  Application.ScreenUpdating = True
0 hits

【28269】とある条件のレコードだけ合計が必要な場合 EXCEL_VBA中の下 05/9/1(木) 18:35 質問
【28272】Re:とある条件のレコードだけ合計が必要な... ponpon 05/9/1(木) 20:39 発言
【28279】Re:とある条件のレコードだけ合計が必要な... ichinose 05/9/1(木) 22:59 発言
【28390】Re:とある条件のレコードだけ合計が必要な... EXCEL_VBA中の下 05/9/5(月) 10:59 発言
【28392】Re:とある条件のレコードだけ合計が必要な... ichinose 05/9/5(月) 12:03 発言
【28393】Re:とある条件のレコードだけ合計が必要な... EXCEL_VBA中の下 05/9/5(月) 13:37 お礼

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