vba - 未设置对象变量(错误 91)

Question

我对 VBA 的世界相当陌生，我的任务是编写一些代码，这些代码将逐步遍历 A 列中的公司名称，当找到该名称时，代码会将相关行复制并粘贴到新创建的工作簿中。然后它应该继续使用下一个名称，依此类推。在测试代​​码的过程中，但我已经进入了今天，我现在在 rngG.Select 行上得到了对象变量错误

任何人都可以提供帮助，因为我已经看了一个小时，现在完全让我感到困惑？

Sub CrystalUtilitesLtd()


Dim Wk As Workbook
Dim c As Range
Dim rngG As Range

Application.DisplayAlerts = False

For Each c In Intersect(ActiveSheet.UsedRange, Columns("a"))
    If c = "3rd Party - Crystal Utilities Ltd" Then
        If rngG Is Nothing Then Set rngG = c.EntireRow
        Set rngG = Union(rngG, c.EntireRow)
    End If
Next c
rngG.Select
Selection.Copy

Workbooks.Open "I:\Data\OMR8293\General\Ops Team\Customer Transfer Team\TPI Registration Reporting\TPI Registration Data Template1.xlsx"
Range("A2").Select
Selection.PasteSpecial xlPasteValues
Range("A1:AG1").EntireColumn.AutoFit
ActiveWorkbook.SaveAs ("I:\Data\OMR8293\General\Ops Team\Customer Transfer Team\TPI Registration Reporting\Crystal Utilities Ltd\Registrations_1010112503_" _
                        & Format(Now(), "YYYYMMDD") & ".xlsx")
ActiveWorkbook.Close

Call EnergyAnalystUK

Application.DisplayAlerts = True

End Sub

Answer 1

替换以下两行代码...

rngG.Select
Selection.Copy

有了这些线条

If Not rngG Is Nothing Then
    rngG.Copy
Else
    MsgBox "No range to copy.", vbExclamation
    Exit Sub
End If

原因是如果 c <> "3rd Party - Crystal Utilities Ltd"然后 rngG对象从未分配范围，因此它仍然是 Nothing , 因为你不能做 Nothing.Select你会得到一个 Object Variable 或 With Block Not Set 错误。

通过上述更改，您的完整代码将是这样的......

Sub CrystalUtilitesLtd()


Dim Wk As Workbook
Dim c As Range
Dim rngG As Range

Application.DisplayAlerts = False

For Each c In Intersect(ActiveSheet.UsedRange, Columns("a"))
    If LCase(VBA.Trim(c)) = "3rd party - crystal utilities ltd" Then
        If rngG Is Nothing Then Set rngG = c.EntireRow
        Set rngG = Union(rngG, c.EntireRow)
    End If
Next c

If Not rngG Is Nothing Then
    rngG.Copy
    Workbooks.Open "I:\Data\OMR8293\General\Ops Team\Customer Transfer Team\TPI Registration Reporting\TPI Registration Data Template1.xlsx"
    Range("A2").Select
    Selection.PasteSpecial xlPasteValues
    Range("A1:AG1").EntireColumn.AutoFit
    ActiveWorkbook.SaveAs ("I:\Data\OMR8293\General\Ops Team\Customer Transfer Team\TPI Registration Reporting\Crystal Utilities Ltd\Registrations_1010112503_" _
                            & Format(Now(), "YYYYMMDD") & ".xlsx")
    ActiveWorkbook.Close
Else
    MsgBox "No range to copy.", vbExclamation
End If

Call EnergyAnalystUK

Application.DisplayAlerts = True

End Sub