首页 文章

VBA运行时错误424（需要对象）/匹配工作表之间的单元格

提问于
浏览 次
-1

我有一张带有x列数的主表 . 我正在尝试在每列中的第一个单元格和多个工作表中的另一个单元格之间找到匹配项 . 找到匹配后，我正在尝试复制整个列（不包括匹配的值）并将其粘贴到找到工作表的工作表上 . 我一直收到运行时错误424.我写的代码如下

Dim lc As Long
Dim cell1 As Range, cell2 As Range
Dim wbk As Workbook
Dim sh4 As Worksheet
Dim v As Long


Set wbk = ThisWorkbook
Set sh4 = Sheets(4)

lc = sh4.Cells(1, Columns.Count).End(xlToLeft).Column

For v = 1 To lc
Set cell1 = sh4.Cells(1, v)

    For Each Sheet In wbk.Worksheets
        If Sheet.Index > 5 Then
        Sheet.Select
        Set cell2 = Range("B1")

            If StrComp(CStr(cell1.Value), CStr(cell2.Value), vbBinaryCompare) = 0 Then
                  If cell1.Offset(0, 0).Value = cell2.Offset(0, 0).Value Then
                    sh1.Range(Cells(2, v), Cells(28, v)).Resize(1, 2).Copy
                    Sheet.Range("F2").PasteSpecial xlPasteValues
                  End If
            End If
        End If

    Next Sheet
    Set cell1 = Nothing
    Set cell2 = Nothing
Next v

我觉得这很简单，我错过了 . 帮助将不胜感激 . 谢谢 .

excel vba excel-vba

1 回答

  • 0

    您的代码似乎有很多问题 . 我继续前进并添加了一些快速修复程序，希望它能正常运行 . 我个人而言，讨厌Excel .Paste 和 .PasteSpecial 函数（仇恨是相互的）所以我总是最终创建列表或使用变量来复制周围的东西 .

    不幸的是，我不认为 .Resize 功能能达到您的预期 . 通过以你的方式使用它，你只是从你调整大小的范围的第一个单元格开始抓取第一行和前两列 .

    这里有一些代码应该与代码完全相同，减去错误消息！如果您需要一些帮助来了解我所做的一些改变或如何实现您的目标，请不要犹豫！

    Dim lc As Long
Dim cell1 As Range, cell2 As Range
Dim wbk As Workbook
Dim sh4 As Worksheet, sh as Worksheet
Dim v As Long
Dim value1 As Variant, value2 As Variant

Set wbk = ThisWorkbook
Set sh4 = wbk.Sheets(4)

lc = sh4.Cells(1, Columns.Count).End(xlToLeft).Column

For v = 1 To lc
    Set cell1 = sh4.Cells(1, v)
    value1 = cell1.Value

    For Each sh In wbk.Worksheets
        If sh.Index > 5 Then
            sh.Select
            Set cell2 = sh.Range("B1")

            If StrComp(CStr(value1), CStr(value2), vbBinaryCompare) = 0 Then
                If value1 = value2 Then
                    sh.Range("F2") = sh4.Cells(2, v)
                    sh.Range("G2") = sh4.Cells(2, v + 1)
                End If
            End If
        End If
    Next sh

    Set cell1 = Nothing
    Set cell2 = Nothing

Next v
    回复于

相关问题