Question

绝对不是我是VBA开发人员，但是对于为什么此方法不起作用的任何帮助将不胜感激...

问题：

分析所有工作表，最后一个除外。
检查I和J列是否包含X，如果包含X，则获取该行并将其复制到最后一个工作表。

突出显示的错误在以下行：对于Workbook.Worksheets中的每一个问题。我不确定为什么。

下面是我的代码，但是没有编译，并给我错误代码424-必需对象。

Sub CopyData()

Application.ScreenUpdating = False
Dim pasteSheet As Worksheet

Set pasteSheet = Worksheets("Remediation Summary")

For Each ws In ThisWorkbook.Worksheets
If ws.Index < (ThisWorkbook.Worksheets.Count - 1) Then
'check column i for x
For Each icell In ws.Range("i1:i200").Cells
If icell.Value Like ("X") Or ("x") Then
    Rows(icell.RowIndex).Copy
    pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End If
Next icell

'check column j for x
For Each jcell In ws.Range("j1:j200").Cells
If jcell.Value Like ("X") Or ("x") Then
    Rows(jcell.RowIndex).Copy
    pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End If
Next jcell
End If
Next ws

End Sub

Answer 1

Option Explicit确实是一个很好的帮助者-将其写在每个模块/类/工作表的顶部。它会立即告诉您是否存在一些未声明的变量。

就您而言，ws应该声明为工作表，只要您使用for-each循环来遍历Worksheets集合：

Option Explicit

Sub CopyData()

    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        Debug.Print ws.Name
    Next ws

End Sub

Option Explicit MSDN

关于这部分-If icell.Value Like ("X") Or ("x") Then，请考虑这样重写：

If UCase(icell) = "X" Then。这样比较容易理解，并且当比较没有其他符号Like时就不需要?*。

Excel VBA like operator

Answer 2

更新的代码库：

Sub CopyData()

Application.ScreenUpdating = False
Dim pasteSheet As Worksheet

Set pasteSheet = Worksheets("Remediation Summary")

For Each ws In ThisWorkbook.Worksheets
If ws.Index < (ThisWorkbook.Worksheets.Count - 1) Then
    'check column i for x
    For Each icell In ws.Range("i0:i200").Cells
    If icell.Value Like ("X") Or ("x") Then
        Rows(icell.RowIndex).Copy
        pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
    End If
    Next icell

    'check column j for x
    For Each jcell In ws.Range("j0:j200").Cells
    If jcell.Value Like ("X") Or ("x") Then
        Rows(jcell.RowIndex).Copy
        pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
    End If
    Next jcell
End If
Next ws

End Sub

Answer 3

根据我的测试，请尝试以下代码：

Option Explicit
Sub CopyData()

Application.ScreenUpdating = False
Dim pasteSheet As Worksheet
Dim ws As Worksheet
Dim icell As Range
Dim jcell As Range
Set pasteSheet = Worksheets("Remediation Summary")

For Each ws In ThisWorkbook.Worksheets
If ws.Index < (ThisWorkbook.Worksheets.Count - 1) Then
'check column i for x
For Each icell In ws.Range("i1:i200").Cells
If UCase(icell) = "X" Or UCase(icell) = "x" Then
    pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow.Value = icell.EntireRow.Value
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End If
Next icell

'check column j for x
For Each jcell In ws.Range("j1:j200").Cells
If UCase(jcell) = "X" Or UCase(jcell) = "x" Then
    pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow.Value = jcell.EntireRow.Value
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End If
Next jcell
End If
Next ws

End Sub

Answer 4

Sub CopyData()

    Dim pasteSheet As Worksheet, ws As Worksheet, icell As Range
    Set pasteSheet = Worksheets("Remediation Summary") 'ThisWorkbook?

    For Each ws In ThisWorkbook.Worksheets
        If ws.Index < (ThisWorkbook.Worksheets.Count - 1) Then
            'check column i,j for x
            For Each icell In ws.Range("i1:i200").Cells
                If LCase(icell.Value) = "x" Or LCase(icell.Offset(0, 1).Value) = "x" Then
                    pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow.Value = _
                                    icell.EntireRow.Value
                End If
            Next icell
        End If
    Next ws

End Sub

VBA Excel脚本-运行时错误424（特定于代码）

4 个答案: