1

アクティブシートの列「Q」をループダウンし、27 から 40 の間の値を見つけて、そのセルを (-1, -16) で示されたセルの周囲の領域とともにコピーしようとしています。シート。

現在、ループが正しい値と領域をキャッチしていることを確認するために 、領域を太字にしています。

私は VBA を初めて使用するので、誰かが私の問題を解決する方法について何かアドバイスやアドバイスをくれたら、とても感謝しています。 

Sub Test2()
Application.ScreenUpdating = False
ActiveSheet.Range("Q13").Select
Let x = 0
Do While x < 500
    If ActiveCell.Value >= 27 And ActiveCell.Value <= 40 Then
        Range(ActiveCell, ActiveCell.Offset(-1, -16)).Select
        Selection.Font.Bold = True
        ActiveCell.Offset(2, 16).Activate
    Else
        ActiveCell.Offset(1, 0).Select
    End If
    x = x + 1
Loop
End Sub
4

1 に答える 1

1

以下のコードを試してください：

  • マクロが終了したら、常に ScreenUpdating プロパティを True に戻します。このリンクを確認してください。
  • コードで Select/Activate を使用しないでください。このリンクを確認してください
  • 複数のシートを操作する場合は、必ずシートを明示的に指定してください。
  • ActiveCell、ActiveSheet の使用を避け、明示的に参照してください。 
Sub Test2()

    Application.ScreenUpdating = False


    Dim lastRow As Long
    lastRow = Sheets("sheet1").Range("Q" & Rows.Count).End(xlUp).Row

    Dim rng As Range, cell As Range
    Set rng = Sheets("sheet1").Range("Q1:Q" & lastRow)

    For Each cell In rng

        If cell.Value >= 27 And cell.Value <= 40 Then
            Sheets("sheet1").Range(cell, cell.Offset(0, -16)).Copy Sheets("sheet2").Cells(Sheets("sheet2").Range("Q" & Rows.Count).End(xlUp).Row + 1, 1)
        End If
    Next

    Application.ScreenUpdating = True
End Sub
于 2013-05-20T01:09:11.300 に答える