正しい行数がコピーされない

Question

私のコピーのペーストが並んでいない理由を突き止めようと壁に向かって私の頭を叩いています。私は指数が正しく分かったと思ったが、まだ何かが欠けている。データの最初の場合は正しいですが、2番目の場合は1つで、3番目の場合は2つです。最初はそれぞれ2行と4行でしたが、どの文が真であるかにかかわらず、自分のカウンタを更新する必要があることが分かりました。あるよう

私のコードは次のとおりです。

Dim FirstItem As Integer 
Dim SecondItem As Integer 
Dim Offsetcount As Integer 
Dim Rowoffset As Integer 
Dim true_offset As Integer 
Dim myNum As Integer 

Sheets("Sheet2").Activate 
ActiveSheet.Range("C2").Select 
FirstItem = ActiveCell.Value 
SecondItem = ActiveCell.Offset(1, 0).Value 
Offsetcount = 1 
Rowoffset = 0 
true_offset = 1 
myNum = (Range("C" & Rows.Count).End(xlUp).Row) 
'MsgBox myNum 

Do While myNum > 1 

    true_offset = true_offset + 1 

    If FirstItem = SecondItem Then 
      Offsetcount = Offsetcount + 1 
      Rowoffset = Rowoffset + 1 
      SecondItem = ActiveCell.Offset(Offsetcount, 0).Value 
    Else 
      Set myactivecell = ActiveCell 

      Set myActiveWorksheet = ActiveSheet 'Do I need to declare this and the line below? 
      Set myActiveWorkbook = ActiveWorkbook 
      ActiveSheet.Range(ActiveSheet.Cells(true_offset - Rowoffset, 1), ActiveSheet.Cells(true_offset + 1, 1)).EntireRow.Select 
      Selection.Copy 
      Set new_workbook = Workbooks.Add 
      ActiveSheet.Paste 
      myActiveWorkbook.Activate 
      myActiveWorksheet.Activate 
      myactivecell.Activate 

      ActiveCell.Offset(Offsetcount + 1, 0).Select 
      If ActiveCell.Value = "" Then 
       myNum = 0 
      End If 

      FirstItem = ActiveCell.Value 
      SecondItem = ActiveCell.Offset(1, 0).Value 
      Offsetcount = 1 
      myNum = myNum - 1 
      Rowoffset = 0 

    End If 

Loop 

ここではいくつかのサンプルデータの画面キャップです：

https://i.stack.imgur.com/EsA3B.png

Answer 1

[OK]を、私はあなたの現在のコードのための応急処置を教えてくれます。この文から+1を削除しますと

ActiveCell.Offset(Offsetcount + 1, 0).Select 
'       ^^^^ 

は、あなたのコードは本当に完全なリファクタリングを必要とします。あなたは "壁に頭を打つ"しかし、それはプログラミングの良い練習のルールに従わないときは、通常の結果です。

• 、GUIを「模倣」でないプログラムを実行してください選択/例外なくすべてあなたの変数点心もの
• をactivethingドロップし、あなたがあなたのコードでは、あまりにも多くの変数を持ってOption Explicit
• を使用、それらの多くは同じことを追跡するようです。

これが役立ちます。