仅从特定范围复制并使用union

Question

我正在尝试将值从excel工作表复制到另一个excel工作簿。我得到了一个

  

运行时91对象变量错误

rng.copy。但我不明白为什么它不起作用。我只想在程序与单元格值匹配时从行A复制到CV。使用我的评论for循环工作，但复制整行。这是我的代码：

Sub ProgramExport()
  'Dim arr

  'arr3 = Array("Accessible Pedestrian Signals", "Advanced Traffic Signal Control ", "Bathurst Street Bridge Rehabilitation ", "C.I. Centennial Pk Path", _
               "C.I. Etobicoke Valley PK", "C.I. Humber Trail Extension and Gaps", "C.I. Pan Am Trail Expansion - Gatineau Trail", _
               "City Bridge Rehabilitation ", "City-10-Surface Transit Operational Improvement Studies - Phase 3", _
               "City-11-King Street Modelling Study", "City-12-REimagining Yonge North Study", "City-15-Flemingdon Park-Thorncliffe Park Neighbourhood  Cycling Connections", _
               "City-22-Accessible Pedestrian Signals Expansion", "City-26-Geometric Safety Improvements - Removal of Channelized Right Turns", _
               "City-27-Missing sidewalk links - 2017", "City-28-Missing sidewalk links - 2018", "City-37-Installation of Cycling Facilites on Woodbine Ave.", _
               "City-38-Installation of Cycling Facilities on Lakeshore Blvd West", "City-39-Surface Transit Operational Improvement Studies - Phase 1", _
               "City-40-King Street Pilot Implementation", "City-42-Yonge Tomorrow", "City-6-Eglinton Connects Streetscape Improvements and Cycle Tracks", _
               "City-8-East Don Trail", "City-9-Surface Transit Operational Improvement Studies - Phase 2", "Critical Interim Road Rehabilitation ", _
               "Cycling Infrastructure ", "Design of Cherry St Realignment and Bridges", "Ditch Rehabilitation and Culvert Reconstruction", _
               "Don Valley Parkway Rehabilitation", "Engineering Studies", "F.G. Gardiner Interim Repairs", "Facility Improvements ", _
               "Georgetown South City Infrastructure Upgrades", "Greenville and Yonge Street Improvements", _
               "Growth Related Capital Works ", "Guide Rail Replacement Program", "John Street Revitalization Project", "King Liberty Cycling Pedestrian Bridge", _
               "Laneways", "LARP (Lawrence-Allen Revitalization Project) Phase 1", "LED signal Module Conversion ", "Legion Road Extension & Grade Separation", _
               "Local Road Rehabilitation", "Local Speed Limit Reduction", "Major Roads Rehabilitation", "Major SOGR Pooled Contingency ", _
               "N.I. Mill Street Streetscape", "N.I. The Queensway from Islington to Royal York", "Neighborhood Improvements", _
               "North York Service Road Extension", "Pedestrian Safety and Infrastructure Program", _
               "Port Union Road ( Lawrence Ave - Kingston Rd)", "PSI Homewood Depressed Curb", "PXO Visibility Enhancement", _
               "Regent Park Revitalization ", "Retaining Walls Rehabilitation ", "Road Safety Plan (LGTSI) ", "Rouge National Park ", _
               "Salt Management Program", "Sidewalks", "Signs and Markings Asset Management", "Six Points Interchange Redevelopment", _
               "SM Bay Cloverdale", "SM McGill-Granby Village", "SM The Upper Avenue", "Steeles Widenings ( Tapscott Road - Beare Road) ", _
               "System Enhancements for Road Repair & Permits", "Tactile Domes Installation", "Third Party Signals ", "Traffic - Control RESCU", _
               "Traffic Calming", "Traffic Congestion Management ", _
               "Traffic Signals Major Modifications", "Transportation Safety & Local Improvement Program ", "Work for TTC & Others", _
               "Yonge Street Revitalization EA Study (Reimagining Yonge)")

  Dim Program As Range
  Dim rng As Range
  Dim wbThis As Workbook
  Dim newBook As Workbook
  Dim value As String
  Dim userID As String
  Dim fn As String
  Dim programN As Variant
  Dim Cell As Range
  Dim sName As String
  userID = InputBox("Please enter your user id.")

  'For Each programN In arr3
      programN = "Local Road Rehabilitation"
      Set Program = Range("C1:C2000")
      Set newBook = Workbooks.Add
      'UserForm1.Show
      Set wbThis = Workbooks("TS L2L3v111.xlsm")
      Dim test As Worksheet: Set test = wbThis.Worksheets(4)
      'value = InputBox("Please enter the program you'd like to export.")

      fn = "C:\Users\" & userID & "\Desktop\" & programN & ".xlsx"
      'aFN = "C:\Users\ashaikh5\Desktop\Copy of TS L2L3v11.xlsm"
      newBook.SaveAs (fn)
      'FileFormat:=52

      For i = 1 To 2000
         If Cells(i, 3) = programN Then
                If rng Is Nothing Then
                    Set rng = Range(Cells(i, 1), Cells(i, 78))
                Else
                    Set rng = Union(rng, Range(Cells(i, 1), Cells(i, 78)))
                End If
            Else
                'something
         End If

      Next i

      'For Each Cell In Program

          'If Cell = programN Then
              'If rng Is Nothing Then
                'Set rng = Cell.EntireRow
              'Else
                'r = ActiveCell.Row
                'Set rng = Union(rng, Cell.EntireRow)
              'End If
          'Else
              'cell.Font.ColorIndex = 3

      'End If

      'Next
      Dim ws As Worksheet: Set ws = newBook.Worksheets(1)
      erow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
      rng.Copy
      ws.Cells(erow, 1).PasteSpecial xlPasteFormats
      ws.Cells(erow, 1).PasteSpecial xlPasteValues
      ws.Columns("A:L").ColumnWidth = 14
      ws.Columns("C").AutoFit
      ws.Columns("N:CM").ColumnWidth = 14
      'Set wbThis = Workbooks("TS L2L3v111.xlsm")

      'Dim test As Worksheet: Set test = wbThis.Worksheets(4)

      test.Rows(2).Copy
      ws.Cells(1, 1).PasteSpecial
      ws.Columns("F:K").Columns.Group
      ws.Columns("F:K").EntireColumn.Hidden = True
      ws.Columns("R:Z").Columns.Group
      ws.Columns("R:Z").EntireColumn.Hidden = True
      ws.Columns("AH:AP").Columns.Group
      ws.Columns("AH:AP").EntireColumn.Hidden = True
      ws.Columns("AX:BF").Columns.Group
      ws.Columns("AX:BF").EntireColumn.Hidden = True
      ws.Columns("BJ:BN").Columns.Group
      ws.Columns("BJ:BN").EntireColumn.Hidden = True
      ws.Columns("BP:CA").Columns.Group
      ws.Columns("BP:CA").EntireColumn.Hidden = True
      ws.Range("A1", "CM1").End(xlUp).AutoFilter 1
      ActiveWindow.SplitColumn = 13
      ActiveWindow.FreezePanes = True
      ws.Columns("CW:FX").Clear
      ws.Cells.Validation.Delete
      newBook.Save
      newBook.Close
      'Set newBook = Workbooks.Open("C:\Users\" & userID & "\Desktop\" & programN & ".xlsm")
      'Dim test1 As Worksheet: Set test1 = newBook.Worksheets(1)
      'test1.ScrollArea = "$A$1:$CV$2000"
     ' newBook.Save
      'newBook.Close

  'Next programN
End Sub

Answer 1

尝试

If Not rng Is Nothing
    rng.Copy
Else
    MsgBox "rng was not set in the for loop"
End If

修改 您始终可以使用MsgBox（或将光标放在您所关注的行中，即Set rng = Range(Cells(i, 1), Cells(i, 78))，然后转到Debug / Toogle Breakpoint ...以停止代码执行并在其休息时间浏览代码）。

当然，如果它永远不会停在那一行（如果你放假）或者你从未收到过MsgBox，那么代码逻辑会出现问题。

  For i = 1 To 2000
     If Cells(i, 3) = programN Then
            If rng Is Nothing Then
                Set rng = Range(Cells(i, 1), Cells(i, 78))

                MsgBox "Range was set"
                Exit For
            Else
                Set rng = Union(rng, Range(Cells(i, 1), Cells(i, 78)))

                MsgBox "Range was set"
                Exit For
            End If
        Else
            'something
     End If

  Next i