【Excel VBA】 数値が0、もしくは0より大きいデータがSheet1のD列とE列にランダムな間隔で保存されています。

ベストアンサー

NEW! この回答はいかがでしたか? リアクションしてみよう

この返信は削除されました

ThanksImg質問者からのお礼コメント

今回最も近かった方をBAとさせていただきます。 皆さま、ご回答ありがとうございました!

お礼日時:2023/12/8 9:37

その他の回答(3件)

データと言うのが数値であれば(数式ではなく直接入力ね)、 Sub try() Dim rr As Range Dim r1 As Range, r2 As Range Application.ScreenUpdating = False Set r2 = Worksheets("Sheet2").Range("B2") r2.Range("A1:D150").ClearContents Set rr = Worksheets("Sheet1").Range("D:D").SpecialCells(xlCellTypeConstants, xlNumbers) For Each r1 In rr.Areas If WorksheetFunction.Sum(r1.Cells(r1.Rows.Count, 1).Resize(, 2)) > 0 Then r1.Cells(r1.Rows.Count, 1).Resize(, 2).Copy r2 Set r2 = IIf(r2.Column = 4, r2.Offset(1, -2), r2.Offset(, 2)) If r2.Row > 151 Then Exit For End If Next Application.ScreenUpdating = True End Sub

前半の文章と後半の例が同じことを表現しているのちょっと疑問ですが、後半の例をもとに考えました。 Sub Sample()     Dim ws1 As Worksheet: Set ws1 = Worksheets("Sheet1")     Dim ws2 As Worksheet: Set ws2 = Worksheets("Sheet2")     Dim lastRow As Long: lastRow = ws1.Cells(Rows.Count, "D").End(xlUp).row     Dim r1 As Long: r1 = 1     Dim r2 As Long: r2 = 4     With ws1         Do While r1 <= lastRow And r2 <= 303             Dim rng As Range             Set rng = Range(.Cells(r1, "D"), .Cells(r1, "D").End(xlDown)).Resize(, 2)             If WorksheetFunction.Sum(rng) > 0 Then                 r1 = rng(rng.Count).row                 ws2.Cells(r2 \ 2, (((r2 Mod 2)) + 1) * 2).Resize(, 2).Value = .Cells(r1, "D").Resize(, 2).Value                 r1 = rng(rng.Count).row                 r2 = r2 + 1             Else                 r1 = .Cells(r1, "D").End(xlDown).row             End If             r1 = .Cells(r1, "D").End(xlDown).row         Loop     End With End Sub

この返信は削除されました

シート画像載せたほうがわかりやすいです。文章では理解難しいです。

この返信は削除されました