1

このループをコピーして貼り付けるように変更するのを手伝ってくれる人はいますか?

Range("S" & Y).Select に時刻、日付、またはなしの形式のデータがある場合にのみ、同じ行に貼り付けたいRange("F" & Y)。の最後のデータ ポイントまでこれを繰り返したいと思いRange("F" & Y)ます。行にデータがあるRange("F" & Y) ので、貼り付けるべきではありませんRange("S" & Y)。データがある場合、Range("F" & Y)3 行ごとに表示されます。3行ごとに戻る次のデータシーケンスまで、データにおそらく10行のギャップがある場合があります。

エラー: そのデータセットの最後で停止せず、データがなくても貼り付けられRange("F" & Y) ます。

私のコード

Dim lastRow As Long
Range("S16:Y16").Select
Selection.Copy
For Y = 19 To 2000 Step 3

    If Range("F" & Y).Value = lastRow Then Exit For
    Range("S" & Y).Select
    ActiveSheet.Paste
    lastRow = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row

Next Y
Application.ScreenUpdating = True
MsgBox lastRow
4

2 に答える 2

1

いくつかの指針：

  1. まず、lastRowが 2000 よりも大きく、ifステートメントが現在の行番号だけをチェックしていない場合、最後に停止しません。また、一度に 3 行ずつジャンプしているため、この最後の行をスキップする可能性が高くなります。if代わりに次のステートメントを使用することをお勧めします。

    If Range("F" & Y).row > lastRow Then Exit For

  2. 変数についてlastrowは、より正確にするために次のことをお勧めします。

    lastrow = activesheet.cells.find("*", range("A1"), , , xlbyrows, xlprevious).row

  3. また、空白の値をチェックせずにすべての行にデータを貼り付けています。これを使用して空白のセルをチェックします。

    if len(Application.WorksheetFunction.Clean(trim(range("F" & Y).value))) > 0 then
于 2013-04-11T10:24:59.547 に答える
0

おそらく、以下のように S 列から Y 列のワークシート式でこれを行うことができます。

=IF($F:$F<>"",S:S,"")

その数式を列 S から Y にコピーし、次に 2000 にコピーします。

ROW が 3 行ごとにあるかどうかを確認するには、ROW() 関数を使用して行番号を取得し、MOD を使用して 3 で割り切れるかどうかを確認します。

VBAの場合、これを試してください：

Dim lastRow As Long
lastRow = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row

Range("S16:Y16").Copy
For Y = lastRow to 19 Step -3
' check column F and Row=Y for contents
if vba.len(vba.trim(range("F" & Y).value))>0 then  
    ' paste into column S
    Range("S" & Y).PasteSpecial xlPasteAll
end if 
Next 
Application.ScreenUpdating = True
MsgBox lastRow

これで、lastRow から 19 まで BACKWARDS が実行されます

あなたのコードは、セル Range("F" & Y) または Cells(y,6) の値を最後の行の数に対してチェックしていました

于 2013-04-10T10:15:08.853 に答える