使用範圍內的單元格不起作用？

Question

出於某種原因，這是行不通的：

.Range(Cells(1, 1), Cells(lRows, lCols)).Copy 

任何想法？這是上線78

Option Explicit 
Public Sub averageScoreRelay() 
    ' 1. Run from PPT and open an Excel file 
    ' 2. Start at slide 1 and find a box that contains the words "iq_", if it has those words then it will have numbers after it like so "iq_43" or "iq_43, iq_56, iq_72". 
    ' 3. find those words and numbers in the opened Excel file. Needs to recognize that ", " means there is another entry. 
    ' 3. Copy column containing words from ppt ie. "iq_43" 
    ' 4. Paste a Table into ppt with those values 
    ' 5. Do this for every slide 

    'Create variables 
    Dim xlApp As Excel.Application 
    Dim xlWB As Excel.Workbook 
    Dim pptSlide As Slide 
    Dim Shpe As Shape 
    Dim pptText As String 
    Dim pptPres As Object 
    Dim iq_Array As Variant 
    Dim arrayLoop As Integer 
    Dim i As Integer 
    Dim myShape As Object 
    Dim colNumb As Integer 
    Dim size As Integer 
    Dim k As Integer 
    Dim vsblSld As Object 
    Dim lRows As Long 
    Dim lCols As Long 

    colNumb = 5 'Set #of columns in the workbook 

    ' Create new excel instance and open relevant workbook 
    Set xlApp = New Excel.Application 
    'xlApp.Visible = True 'Make Excel visible 
    Set xlWB = xlApp.Workbooks.Open("C:\Users\pinlop\Desktop\Gate\Macro\averageScores\pptxlpratice\dummyavgscore.xlsx", True, False) 'Open relevant workbook 
    If xlWB Is Nothing Then ' may not need this if statement. check later. 
     MsgBox ("Error retrieving Average Score Report, Check file path") 
     Exit Sub 
    End If 

    xlWB.Worksheets.Add After:=xlWB.ActiveSheet 

    'Make pptPres the ppt active 
    Set pptPres = PowerPoint.ActivePresentation 

    'Loop through each pptSlide and check for IQ text box, grab avgScore values and create pptTable 
    For Each pptSlide In pptPres.Slides 
     'searches through shapes in the slide 
     For Each Shpe In pptSlide.Shapes 
      'Identify if there is text frame 
      k = 1 
      If Shpe.HasTextFrame Then 
       'Identify if there's text in text frame 
       If Shpe.TextFrame.HasText Then 
        pptText = Shpe.TextFrame.TextRange 
        If InStr(1, pptText, "iq_") > 0 Then 'Identify if within text there is "iq_" All IQ's have to be formatted like this "iq_42, iq_43" for now 
         iq_Array = Split(pptText, ", ")    'set iq_Array as an array of the split iq's 
         size = UBound(iq_Array) - LBound(iq_Array) 
         For arrayLoop = 0 To size 'loop for each iq_array 
          For i = 1 To colNumb 'loops for checking each column 
           If i = 1 And arrayLoop = 0 Then 'Copies the first column for every slide 
            xlWB.Worksheets("Sheet1").Columns(1).Copy 'copy column 
            xlWB.Worksheets("Sheet2").Paste Destination:=xlWB.Worksheets("Sheet2").Columns(1) 
           ElseIf xlWB.Worksheets("Sheet1").Cells(1, i) = iq_Array(arrayLoop) And i <> 1 Then 'if iq in ppt = iq in xl and if not the first cell then execute 
            k = k + 1 
            xlWB.Worksheets("Sheet1").Columns(i).Copy 
            xlWB.Worksheets("Sheet2").Paste Destination:=xlWB.Worksheets("Sheet2").Columns(k) 
           End If 
          Next i 
         Next arrayLoop 
        End If 
       End If 
      End If 
     Next Shpe 

    'calculate last row and last column 
    With xlWB.Worksheets("Sheet2") 
     lRows = .Cells(.Rows.Count, 1).End(xlUp).Row 
     lCols = .Cells(1, .Columns.Count).End(xlToLeft).Column 
     .Range(Cells(1, 1), Cells(lRows, lCols)).Copy 
    End With 
      pptSlide.Shapes.PasteSpecial DataType:=ppPasteHTML, Link:=msoFalse 
      Set myShape = pptSlide.Shapes(pptSlide.Shapes.Count) 
      'Set position: 
      myShape.Left = 66 
      myShape.Top = 152 
      xlWB.Worksheets("Sheet2").Range("A1:P10").Clear 
    Next pptSlide 

    xlWB.Worksheets("Sheet2").Delete 

End Sub 

Answer 1

它應該是這樣的：

.Range(.Cells(1, 1), .Cells(lRows, lCols)).Copy 

這是每個人都經歷VBA的錯誤之一，如果他去深一點。原因是Cells和Range都應該被引用到工作表中，否則他們會引用ActiveSheet。

---

並且通常考慮使用Long instead of Integer in your code。