Question

我有一个包含多个工作表的Excel工作簿。它们中的每一个在工作表的不同位置包含值“N”。我需要将值“N”右边的值复制到单独的工作表。复制的值应作为列存储在工作表中。

我假设我需要遍历每个工作表，找到“N”单元格的地址并复制/粘贴右边的单元格：

'Define last row and column

Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("B1"), _
                            LookAt:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function

Function LastCol(sh As Worksheet)
    On Error Resume Next
    LastCol = sh.Cells.Find(What:="*", _
                            After:=sh.Range("B1"), _
                            LookAt:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column
    On Error GoTo 0
End Function

Sub WorksheetLoop()

    ' Add a new summary worksheet

    Set DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.Name = "MergeSheet"

    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim copyra As Range
    For Each sh In ActiveWorkbook.Worksheets
        Dim ra As Range
        'Find address of N in every Worksheet
        Set ra = sh.Cells.Find(What:="N", LookIn:=xlFormulas, LookAt _
                               :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                               False, SearchFormat:=False)
        ' Find the address of the right cell
        copyra = ra + 1
        'Copy the cell to the MergeSheet
        copyra.Copy
        With DestSh.Cells(Last + 1, "B")
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
        End With


    Next

End Sub

但是，当我运行此代码时，它会返回错误“当前范围内的重复声明”，并且我不清楚我在哪里有重复的声明。

Answer 1

在Sub WorksheetLoop()

此Dim DestSh As Worksheet应该在Set DestSh = ActiveWorkbook.Worksheets.Add

之前

在代码顶部使用Option Explicit，您还会意识到必须声明

  Dim Last As Long

并且您有稍后尝试添加内容的范围变量，这可能会导致类型不匹配，例如

你可能想要

Set copyra = ra.Offset(, 1)

而不是

 copyra = ra + 1

Answer 2

我想出了如何解决问题。下面是那些可能需要它的人的代码

 Option Explicit

    'Define last row and column

    Function LastRow(sh As Worksheet)
        On Error Resume Next
        LastRow = sh.Cells.Find(What:="*", _
                                After:=sh.Range("B1"), _
                                Lookat:=xlPart, _
                                LookIn:=xlFormulas, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlPrevious, _
                                MatchCase:=False).Row
        On Error GoTo 0
    End Function

    Function LastCol(sh As Worksheet)
        On Error Resume Next
        LastCol = sh.Cells.Find(What:="*", _
                                After:=sh.Range("B1"), _
                                Lookat:=xlPart, _
                                LookIn:=xlFormulas, _
                                SearchOrder:=xlByColumns, _
                                SearchDirection:=xlPrevious, _
                                MatchCase:=False).Column
        On Error GoTo 0
    End Function

    Sub WorksheetLoop()

        ' Add a new summary worksheet

        Dim sh As Worksheet
        Dim DestSh As Worksheet
        Dim Last As Long
        Dim copyra As Range
        Dim ra As Range
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With


        Set DestSh = ActiveWorkbook.Worksheets.Add
        DestSh.Name = "MergeSheet"



        For Each sh In ActiveWorkbook.Worksheets
            If sh.Name <> DestSh.Name Then

                ' Find the last row with data on the summary worksheet.
                Last = LastRow(DestSh)


                'Find address of N in every Worksheet
                Set ra = sh.Cells.Find(What:="N", LookIn:=xlFormulas, Lookat _
                                       :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                                       False, SearchFormat:=False)
                ' Find the address of the right cell
                Set copyra = ra.Offset(, 1)
                'Copy the cell to the MergeSheet
                copyra.Copy

                With DestSh.Cells(Last + 1, "B")
                    .PasteSpecial xlPasteValues
                    .PasteSpecial xlPasteFormats
                    Application.CutCopyMode = False
                End With

            End If
        Next

    End Sub

查找单元格并将以下单元格复制到单独的工作表中

2 个答案: