|    | 
     こんにちは。 
現在までの状況を把握してません。 
 
また、↓入ってません。 
>7〜10行までにある数値の件数を11行目に、金額の合計を12行目に、それぞれ 
>各列毎に算出します。 
 
 
Sub PLAS() 
  Dim i As Long 
  Dim j As Long 
  Dim 先頭行 As Long 
  Dim 最終行 As Long 
  Dim 対象データ As Variant 
  Dim 合計(5) As Variant 
  Dim 小計(5) As Variant 
  Dim ブランク As Boolean 
 
  With ActiveSheet 
    先頭行 = 7 
    最終行 = .Cells(65536, "G").End(xlUp).Row + 1 
    For i = 先頭行 To 最終行 
 
      .Cells(i, "G").Resize(, 7).Select '←確認用に1度入れてみるといいです。 
       
      対象データ = .Cells(i, "G").Resize(, 6).Value 
      If 対象データ(1, 1) = "" Then 
        If ブランク Then 
          .Cells(i, "G").Resize(, 7).Value = 小計 
          .Cells(i, "G").Resize(, 7).Font.Bold = True 
          For j = 0 To 5 
            合計(j) = 合計(j) + 小計(j) 
            小計(j) = 0 
          Next j 
          ブランク = False 
        End If 
      Else 
        If 対象データ(1, 1) <> "" Then 
          ブランク = True 
          If IsNumeric(Trim(対象データ(1, 1))) Then 
           小計(0) = 小計(0) + 1 
          End If 
          For j = 0 To 6 
            小計(j) = 小計(j) + Val(対象データ(1, j)) 
          Next j 
        End If 
      End If 
    Next i 
    .Cells(i, "G").Resize(, 7).Value = 合計 
    .Cells(i, "G").Resize(, 7).Font.Bold = True 
  End With 
End Sub 
 
********************** 
Sub sgh() 
  Dim Cure As Range, Gcure As Range, STR As Range, GK() As Long 
  Dim CCR As Long 
  Set STR = Range("G7") 
  CCR = STR.End(xlDown).End(xlToRight).Column - STR.Column + 1 
  ReDim GK(1 To CCR) 
  Do Until STR.End(xlDown).Row = 65536 
    Set STR = STR.End(xlDown) 
    With STR 'Range("G8") 
      Set Gcure = Nothing 
      Set Cure = .CurrentRegion 
      With Cure 
         Set Gcure = .Offset(.Rows.Count).Resize(1) 
         For i = 1 To .Cells.Columns.Count 
          Gcure.Cells(i).Value = Application.Sum(.Cells.Columns(i)) 
          Gcure.Cells(i).Font.Bold = True 
          GK(i) = GK(i) + Application.Sum(.Cells.Columns(i)) 
         Next 
      End With 
    End With 
    Set STR = Gcure.Cells(i) 
    Set Cure = Nothing 
  Loop 
  Gcure.Cells(i).Resize(, CCR).Value = GK 
  Gcure.Cells(i).Resize(, CCR).Font.Bold = True 
  Set STR = Nothing 
  Set Gcure = Nothing 
  Erase GK 
  End 
End Sub 
 
 | 
     
    
   |