2017-06-22 26 views
0
DateSort = Cells(Cells.Rows.Count, "B").End(xlUp).Row 

For currentDate = 2 To DateSort 
    If Range("B" & currentDate) <> Range("B" & currentDate + 1) Then 
     currentDate = currentDate + 1 
     myRange = "A" & currentDate & ":" & "Q" & DateSort 
     Range(myRange).Select 
     Selection.Copy 
     Selection.Clear 
     myNewRange = "A" & currentDate + 1 
     Range(myRange).PasteSpecial 
     Selection.PasteSpecial 

    End If 

Next 

私のワークシートの列 "B"に日付があります。私は日付の各グループの間に空白の行を入れたいと思います。 (すでにソートされています)Excel VBAで日付間に空白を追加する行を移動しようとしています

現在、私のコードは新しい日付をチェックし、残りの日付を選択し、コピーしてデータを消去しますが、新しい範囲に貼り付けるときに失敗します。

+0

完璧に動作します。 – Jeeped

答えて

0

ロジックを変更して動作させようとしましたが、コードが正しく書かれていないためにエラーが発生しました。多くの異なる日付がある場合は、最後の2つの日付にスペースがありません。ここで

datesort = Cells(Cells.Rows.Count, "B").End(xlUp).Row 

For currentDate = 2 To datesort 
    If Range("B" & currentDate) <> Range("B" & currentDate + 1) Then 
     currentDate = currentDate + 1 
     myRange = "A" & currentDate & ":" & "Q" & datesort 
     Range(myRange).Select 
     Selection.Copy 
     'Selection.Clear 
     myNewRange = "A" & currentDate + 1 
     Range(myNewRange).PasteSpecial 
     Range("B" & currentDate).Clear 
     'Selection.PasteSpecial 
     datesort = datesort + 1 
    End If 

Next 

は主要な変更とコードの別のバージョンですが、行はその後、ボトムアップから仕事挿入する場合には、

datesort = Cells(Cells.Rows.Count, "B").End(xlUp).Row 

For currentdate = 2 To datesort * 2 
    If Range("B" & currentdate) <> Range("B" & currentdate + 1) Then 
     Range(Range("B" & currentdate + 1), Range("B" & currentdate + 1).End(xlDown)).Select 

     If Selection.Cells.Count < 20000 Then 
      currentdate = currentdate + 1 
      Selection.Copy 
      Selection.Offset(1, 0).Select 
      Selection.PasteSpecial 
      Range("B" & currentdate).Clear 
     End If 

    End If 

Next 
+0

これはうまく動作し、決して3つ以上の異なる日付であってはなりません。私のコードをより良く書けるようにするにはどうしたらよいでしょうか?私は彼のスタイルをコピーしようとしているので、他人のコードを修正しています。 –

関連する問題