VBAでCSVファイル内の行の特定の間隔ここで、このフォーラムでは、いくつかの素晴らしい人たちに

Question

感謝を削除し、私は私が必要なものについては、以下のマクロを使用することができました：要するに

Public Sub main() 
    'declaration 
    Dim rng As Range 
    Const SourceRange = "H" 
    Dim NumRange As Range, formulaCell As Range 
    Dim SumAddr As String 
    Dim c As Long 

    'Loop trough all rows 
    Set rng = Range("H2") 
    While rng.Value <> "" 
     rng.Offset(20).Resize(1).EntireRow.Insert 
     Set rng = rng.Offset(21) 
    Wend 

    'Fill the Blank Rows in A 
    Columns("A:A").Select 
    Selection.SpecialCells(xlCellTypeBlanks).Select 
    Selection.FormulaR1C1 = "=R[-1]C" 


    For Each NumRange In Columns(SourceRange).SpecialCells(xlConstants, xlNumbers).Areas 
     SumAddr = NumRange.Address(False, False) 
     Set formulaCell = NumRange.Offset(NumRange.Count, 0).Resize(1, 1) 
     formulaCell.Formula = "=SUM(" & SumAddr & ")" 

     'change formatting to your liking: 
     formulaCell.Font.Bold = True 
     formulaCell.Font.Color = RGB(255, 0, 0) 

     c = NumRange.Count 
    Next NumRange 

End Sub 

、これが作成されます20行目毎の行は空白行の列「A」の上のセルから番号を受け取り、列「H」の20番目の前のセルを合計して空白行に「合計スコア」を設定します。

もう1つ質問があります。

上記のマクロを実行すると、20行と20行の合計が新しい行に追加されます。理想的には、合計された20行のすべてを削除し、追加された行を残したいだけです。これの問題は、前のマクロの最後の部分が与えられた数のセルを合計し、行を削除すると加算が間違っていることです（列Aの上のセルの番号も同様です）。

マクロに何かを追加して、列Aの前のセルの合計と数値に影響を与えずに20行を削除する方法はありますか？

行2-21を削除し、行22をスキップし、行23-42を削除し、行43をスキップし、行44-63を削除し、行64をスキップするなどのようになります。

これはおそらく、以前に投稿されたマクロを変更する必要があることを意味しますが、尋ねる価値はあると思います。

ありがとうございました。

ベスト、ここでヘルゲ

Answer 1

あなたが行く：

Public Sub main() 
    'declaration 
    Dim rng As Range 
    Const SourceRange = "H" 
    Dim NumRange As Range, formulaCell As Range 
    Dim SumAddr As String 
    Dim c As Long 
    Dim iFirstRow As Integer, iLastCell As Integer 


    'Loop trough all rows in H column 
    Set rng = Range(SourceRange & "2") 
    While rng.Value <> "" 
     rng.Offset(20).Resize(1).EntireRow.Insert 
     With rng.Offset(20) 
      .Formula = "=sum(" & SourceRange & rng.Row & ":" & SourceRange & rng.Offset(19).Row & ")" 
      .Formula = .Value2 

      'change formatting to your liking: 
      .Font.Bold = True 
      .Font.Color = RGB(255, 0, 0) 

      'set next group start 
      Set rng = rng.Offset(21) 

      'delete rows 
      iFirstRow = .Column - 1 
      With Range(.Offset(-20, -iFirstRow), .Offset(-1, -iFirstRow)) 

       iLastCell = .Cells(.Rows.Count, "A").End(xlUp).Row 

       'Fill the Blank Rows in A 
       With Cells(rng.Offset(-1).Row, 1) 
        .Formula = "=" & Cells(iLastCell, 1).Address 
        .Formula = .Value2 
       End With 

       'Delete group rows 
       .EntireRow.Delete 
      End With 

     End With 
    Wend 
End Sub