Question

我有两张data和PrevErrCheck张。我正在检查工作表数据中所有出现的变量VarVal（此变量在PrevErrCheck的E1单元格中有数据）并将整行复制到工作表PrevErrCheck。但我在这里遇到的问题是多次运行宏覆盖数据。我想将复制的行保存在工作表数据中，每当我下次运行时，它都应该复制到下一个空白行。

我目前正在使用下面的代码但有点混淆如何整合选项以查找PrevErrCheck上的最后一行并复制下面的行

Sub PrevErrCheck()    
    Dim spem As Workbook
    Dim PrevErrCheck As Worksheet
    Dim data As Worksheet
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long

    Set spem = Excel.Workbooks("SwitchPortErrorMonitor.xlsm")
    Set PrevErrCheck = spem.Worksheets("PrevErrCheck")
    Set data = spem.Worksheets("data")

    spem.Worksheets("PrevErrCheck").Activate 
    VarVal = PrevErrCheck.Cells(1, "E").Value
    I = data.UsedRange.Rows.count
    J = PrevErrCheck.UsedRange.Rows.count

    If J = 1 Then
        If Application.WorksheetFunction.CountA(PrevErrCheck.UsedRange) = 0 Then J = 0
    End If

    Set xRg = data.Range("X:X")
    On Error Resume Next

    Application.ScreenUpdating = False

    J = 3
    For K = 1 To xRg.count      
        If CStr(xRg(K).Value) = VarVal And Not IsEmpty(VarVal) Then
            xRg(K).EntireRow.Copy Destination:=PrevErrCheck.Range("A" & J + 1)
            PrevErrCheck.Range("X" & J + 1).ClearContents
            J = J + 1
        End If    
    Next

    Application.ScreenUpdating = True
End Sub

Answer 1

在循环之前你有J = 3，这可能是个问题。 xRg.count始终返回1048576，您应该使用更具体的内容。试试这个：

Set spem = Excel.Workbooks("SwitchPortErrorMonitor.xlsm")
Set PrevErrCheck = spem.Worksheets("PrevErrCheck")
VarVal = PrevErrCheck.Cells(1, "E").Value
If IsEmpty(VarVal) Then Exit Sub

Set data = spem.Worksheets("data")

spem.Worksheets("PrevErrCheck").Activate
I = data.UsedRange.Rows.Count
J = PrevErrCheck.UsedRange.Rows.Count + 1
If J = 2 Then
    If IsEmpty(PrevErrCheck.Cells(1, 1)) Then J = 1
End If

'    If J = 1 Then
'        If Application.WorksheetFunction.CountA(PrevErrCheck.UsedRange) = 0 Then J = 0
'    End If

'    Set xRg = data.Range("X:X")
'    On Error Resume Next

'    Application.ScreenUpdating = False

'    J = 3
For K = 1 To I
    If CStr(data.Cells(K, "X").Value) = VarVal Then
        data.Cells(K, 1).EntireRow.Copy Destination:=PrevErrCheck.Range("A" & J)
        PrevErrCheck.Range("X" & J).ClearContents
        J = J + 1
    End If
Next

'   Application.ScreenUpdating = True
End Sub

将整个行从一个Excel工作表复制到另一个工作表的下一个空行

1 个答案: