VBA Excel - 特定の間隔で行を削除する

Question

私はこのフォーラムを初めて利用しています。

私は必要な情報を得るためにいくつかのVBAモジュールを適用する必要があるCSVファイルを持っています。要するに

、私は一緒に次の3つのマクロを持っている：

1. を（列A）上のセルからの数を取り、中に空白を埋める
2. ごとに20行新しい行を作成します。この番号の新しい行
3. 新しい行の前の20行から列Hの数値を合計して合計スコアを取得します。これは、新しい行が表示される限り（20行ごと）続きます。

これら3つのマクロを1つのマクロで取得することはできますか？これにより、これらのマクロを使用する必要のある他の人に簡単に渡すことができます。

現在のコード：

' Step 1 
Sub Insert20_v2() 
    Dim rng As Range 

    Set rng = Range("H2") 
    While rng.Value <> "" 
     rng.Offset(20).Resize(1).EntireRow.Insert 
     Set rng = rng.Offset(21) 
    Wend 
End Sub 

' Step 2 
Sub FillBlanks() 
    Columns("A:A").Select 
    Selection.SpecialCells(xlCellTypeBlanks).Select 
Selection.FormulaR1C1 = "=R[-1]C" 

End Sub 

' Step 3 
Sub AutoSum() 
    Const SourceRange = "H" 
    Dim NumRange As Range, formulaCell As Range 
    Dim SumAddr As String 
    Dim c As Long 

    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 

は、任意の助けてくれてありがとう。 ベスト、

ヘルゲ

Answer 1

これは難しくありません。

Public Sub main() 
     'deklaration 
     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 

Answer 2

あなたが作成した他のすべての潜水艦を呼び出す単一Subを作成することができます。

例：

Sub DoAllTasks() 

    Insert20_v2 
    FillBlanks 
    AutoSum 

End Sub 

次に、あなただけのボタンを作成し、それにDoAllTasksを割り当てるか、直接マクロを実行する必要があります。

HTH;）