Question

我是excel / vba的新手，并尝试使用宏来检查列的值为true，当它看到该值时，我希望将该行的部分内容复制到我的列中的另一个工作表中。然后我需要它迭代其他行并执行相同的检查。这是我目前的代码。

Sub Macro3()
'
' Macro3 Macro
'

'
Sheets("Aspen Data").Select
Dim tfCol As Range, Cell As Object


Set tfCol = Range("G26:G56")

Sheets("Code").Select
ActiveSheet.Calculate
Sheets("Aspen Data").Select
ActiveSheet.Calculate

For Each Cell In tfCol

    If IsEmpty(Cell) Then
        Exit Sub
    End If

    If Cell.Value = "True" Then

Range("I26:Q26").Select
Selection.Copy
Sheets("AspenHist").Select
Range("B" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    End If

    Next


End Sub

问题似乎在于让我的范围（＆＃34; I26：Q26）在循环中增加1。

Answer 1

试试这个

Sheets("Aspen Data").Select
Dim i As Integer

Sheets("Code").Calculate
Sheets("Aspen Data").Calculate

For i = 26 To 56

If IsEmpty(Cells(i, 7)) Then
    Exit Sub
ElseIf Cells(i, 7).Value = "True" Then

Range(Cells(i, 9), Cells(i, 12)).Copy
Sheets("AspenHist").Activate
Range("B" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Aspen Data").Activate
End If

Next i

Answer 2

无需使用.Select/.Activate/ActiveSheet（请参阅this）来实现目标，您绝对可以使用For Each。试试这个：

Option Explicit

Sub Macro1()
    '
    ' Macro1 Macro
    '

    '
    Dim tfCol As Range, Cell As Object

    Set tfCol = Sheets("Aspen Data").Range("G26:G56")

    Application.ScreenUpdating = False

    Sheets("Code").Calculate
    Sheets("Aspen Data").Calculate

    For Each Cell In tfCol

        If IsEmpty(Cell) Then
            Exit For
        End If

        If Cell.Value = "True" Then

            Sheets("Aspen Data").Range("I" & Cell.Row & ":Q" & Cell.Row).Copy
            Sheets("AspenHist").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial _
                Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End If

    Next

    Application.ScreenUpdating = True

End Sub

尝试将一行中的特定列复制到另一个excel表，基于它满足特定条件

2 个答案: