Question

我想将来自多张工作簿的数据合并到一张我称之为“联合”的工作表中。即使＆＃34;运行时错误＆＃39; 91：对象变量或With block变量未设置＆＃34;出现错误，代码仍然正确评估。但是，仍然会选择/突出显示要粘贴的上一个工作表中的数据。

当我调试错误时，它就在线上： Intersect(Sheets(wsNum).UsedRange, Sheets(wsNum).Range("BF:BI")).Offset(1).Copy

我该如何解决这个问题？感谢

Sub Combine()
'Combines columns of all sheets of a workbook into one sheet "combined"

Dim NR As Long 'starting row to paste data to combined sheet
Dim BR As Long 'length of rows of the copied data in each sheet
Dim wsNum As Long 'number of sheets in workbook
Dim wsOUT As Worksheet 'new workbook created with combined data
Dim titles() As Variant
Dim i As Long

Application.ScreenUpdating = False
On Error Resume Next
Set wsOUT = Sheets("Combine")
On Error GoTo 0

If wsOUT Is Nothing Then
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Combine"
    Set wsOUT = Sheets("Combine")
End If    
wsOUT.Cells.Clear

titles() = Array("Fe Wave", "Fe Amp", "Cr Wave", "Cr Amp", "Worksheet", "", "Bin Center", "FeW Count", "FeA Count", "CrW Count", "CrA Count", "", "FeW tot", "FeA tot", "CrW tot", "CrA tot", "", "FeW%", "FeA%", "CrW%", "CrA%", "", "Int", "FeW Bino", "FeA Bino", "CrW Bino", "CrA Bino", "", "FeW Bino", "FeA Bino", "CrW Bino", "CrA Bino", "", "FeW <X>", "FeA <X>", "CrW <X>", "CrA <X>", "", "FeW std", "FeA std", "CrW std", "CrA std")

With wsOUT        
    For i = LBound(titles) To UBound(titles)
        .Cells(1, 1 + i).Value = titles(i)
    Next i

    .Rows(1).Font.Bold = True
End With

wsOUT.Activate
Range("A2").Select
ActiveWindow.FreezePanes = True
NR = 2

For wsNum = 1 To Sheets.Count
    If UCase(Sheets(wsNum).Name) <> "COMBINE" Then
        Intersect(Sheets(wsNum).UsedRange, Sheets(wsNum).Range("BF:BI")).Offset(1).Copy
        wsOUT.Range("A" & NR).PasteSpecial xlPasteValues
        With wsOUT
            BR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        End With
        wsOUT.Range("E" & NR & ":E" & BR).Value = Sheets(wsNum).Name
        NR = BR + 1
    End If
Next wsNum

wsOUT.Columns.AutoFit
Range("A1").Select
ActiveWindow.ScrollRow = 1
Application.CutCopyMode = False

Application.ScreenUpdating = True

End Sub

Answer 1

如果Sheets(wsNum).UsedRange和Sheets(wsNum).Range("BF:BI")之间存在重叠范围，则需要先查看。

我添加了另一个Range对象（不是必需的，我的调试更容易），Dim IntRng As Range，我将其设置为Set IntRng = Application.Intersect(Sheets(wsNum).UsedRange, Sheets(wsNum).Range("BF:BI"))。

最后，请检查If Not IntRng Is Nothing Then。

尝试使用以下代码替换For循环：

Dim IntRng As Range

For wsNum = 1 To Sheets.Count
    If UCase(Sheets(wsNum).Name) <> "COMBINE" Then
        Set IntRng = Application.Intersect(Sheets(wsNum).UsedRange, Sheets(wsNum).Range("BF:BI"))

        If Not IntRng Is Nothing Then '<-- check is IntRng successfully Set
            IntRng.Offset(1).Copy
            wsOUT.Range("A" & NR).PasteSpecial xlPasteValues

            ' the rest of your coding

        Else '<-- unable to find Intersect between the two ranges
            ' do something....
        End If

        With wsOUT
            BR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        End With
        wsOUT.Range("E" & NR & ":E" & BR).Value = Sheets(wsNum).Name
        NR = BR + 1
    End If
Next wsNum

运行时错误91 - 对象变量或未设置块变量

1 个答案: