Excel VBA：打開工作簿並復制單元格

Question

下面的宏從列表中打開一系列工作簿，然后從中復制一些數據。 它在第一個工作簿上正常工作，然后在第二個工作簿上崩潰。 我嘗試過更改順序，它始終是導致其崩潰的第二個工作簿。

Sub ImportData()
    Dim lastRow As Long
    Dim lastSumRow As Long
    Dim j As Long
    Dim k As Long
    With ActiveSheet
        lastRow = ActiveSheet.Cells(1048576, 1).End(xlUp).Row
    End With
    For k = 2 To lastRow
        k = 2
        lastUsedRow = ThisWorkbook.Sheets("Summary").Cells(1048576, 1).End(xlUp).Row
        If ActiveSheet.Cells(k, 2).Value <> "Imported" Then
            Workbooks.Open Filename:=ThisWorkbook.Path & "\Analysis\" & Cells(k, 1), UpdateLinks:=False
            ActiveWorkbook.Sheets("Summary").Activate
            For j = 3 To 100
                If j Mod 3 = 0 Then
                    ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 1).Value = ActiveWorkbook.Sheets("Summary").Cells(j, 1).Value
                    ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 2).Value = ActiveWorkbook.Sheets("Summary").Cells(j + 1, 2).Value
                    ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 3).Value = ActiveWorkbook.Sheets("Summary").Cells(j + 1, 3).Value
                    ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 4).Value = ActiveWorkbook.Sheets("Summary").Cells(j + 1, 4).Value
                    ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 5).Value = ActiveWorkbook.Sheets("Summary").Cells(j + 2, 2).Value
                    ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 6).Value = ActiveWorkbook.Sheets("Summary").Cells(j + 2, 3).Value
                    ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 7).Value = ActiveWorkbook.Sheets("Summary").Cells(j + 2, 4).Value
                    ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 8).Value = ActiveWorkbook.Sheets("Summary").Cells(j + 1, 5).Value
                End If
            Next j
            ActiveWorkbook.Close
        End If
        ThisWorkbook.Sheets("Setup").Cells(k, 2).Value = "Imported"
    Next k
End Sub

Answer 1

我猜你的錯誤在這里：

 Workbooks.Open Filename:=ThisWorkbook.Path & "\\Analysis\\" & Cells(k, 1), UpdateLinks:=False 'Ooops ^^^^^ 

該.Activate和.Select呼叫進行卷積足夠，我不是真的要花費精力搞清楚什么應該是在你的代碼通過循環第二次運行特定點活動工作表。 不管它是什么，它都與您開始時不同，並且對Cells的無條件調用隱式地引用了當時是ActiveSheet任何工作表。 這將生成錯誤的文件名（或完全失敗），然后滾輪脫落。

最好的辦法是根本不使用Active*對象。 獲取對您正在使用的對象的引用，然后使用它們。 這樣，您就不會有電線交叉的可能性。 在查看時，您可以給他們命名，使您一眼就能清楚地看到正在使用的內容。

在獲得不使用Activate和Select的代碼之前，請結合其他因素。

---

lastSumRow是從來沒有使用過lastUsedRow從未聲明。 我假設他們應該是同一回事。 您應該將Option Explicit放在模塊的頂部，以避免此類錯誤（甚至更糟）。

---

這兩行代碼在一起幾乎沒有什么意義：

  For j = 3 To 100 If j Mod 3 = 0 Then 

如果您只想復制每第3行，請跳過所有除法，僅以3 Step遞增循環計數器：

        For j = 3 To 99 Step 3

請注意，您可以在99處停止，因為100 Mod 3永遠不會為0 。

---

您的With塊此處未使用捕獲的參考...

 With ActiveSheet lastRow = ActiveSheet.Cells(1048576, 1).End(xlUp).Row End With 

...但是您一直使用在With塊中有用的這種模式：

 ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 1).Value = ... ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 2).Value = ... ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 3).Value = ... 

---

硬編碼Cells(1048576, 1)在舊版本的Excel上將失敗。 您應該改用Rows.Count。

---

如評論中所述， k = 2創建一個無限循環。

---

您無需使用以下代碼重復查找要復制到的工作表的最后一行：

 lastUsedRow = ThisWorkbook.Sheets("Summary").Cells(1048576, 1).End(xlUp).Row 

每次您執行“ j ”循環時，最后一行將增加一。 只需將1加到lastUsedRow而不是對所有的體操進行計數。

---

如果您正在使用Worksheets ，請使用Worksheets集合而不是Sheets集合：

 ThisWorkbook.Sheets("Summary") '<--I could return a Chart! 

---

將所有這些放在一起，您將得到類似於以下代碼的內容。 請注意，當您啟動此宏時，我不知道ActiveSheet應該是什么，因此我只是將其命名為存儲在active的變量。 它很可能也是它也獲得參考的其他工作表之一（我不知道）-如果是這樣，您應該將它們合並為一個參考：

Public Sub ImportData()
    Dim lastRow As Long
    Dim lastUsedRow As Long
    Dim dataRow As Long
    Dim fileNameRow As Long

    Dim active As Worksheet
    Set active = ActiveSheet
    With active
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With

    Dim setupSheet As Worksheet
    Set setupSheet = ThisWorkbook.Worksheets("Setup")
    With ThisWorkbook.Worksheets("Summary")
        lastUsedRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        For fileNameRow = 2 To lastRow
            If active.Cells(fileNameRow, 2).Value <> "Imported" Then
                Dim source As Workbook
                Set source = Workbooks.Open(ThisWorkbook.Path & "\Analysis\" & _
                                            active.Cells(fileNameRow, 1), False)
                Dim dataSheet As Worksheet
                Set dataSheet = source.Worksheets("Summary")
                For dataRow = 3 To 99 Step 3
                    .Cells(lastUsedRow, 1).Value = dataSheet.Cells(dataRow, 1).Value
                    .Cells(lastUsedRow, 2).Value = dataSheet.Cells(dataRow + 1, 2).Value
                    .Cells(lastUsedRow, 3).Value = dataSheet.Cells(dataRow + 1, 3).Value
                    .Cells(lastUsedRow, 4).Value = dataSheet.Cells(dataRow + 1, 4).Value
                    .Cells(lastUsedRow, 5).Value = dataSheet.Cells(dataRow + 2, 2).Value
                    .Cells(lastUsedRow, 6).Value = dataSheet.Cells(dataRow + 2, 3).Value
                    .Cells(lastUsedRow, 7).Value = dataSheet.Cells(dataRow + 2, 4).Value
                    .Cells(lastUsedRow, 8).Value = dataSheet.Cells(dataRow + 1, 5).Value
                    lastUsedRow = lastUsedRow + 1
                Next
                source.Close
            End If
            setupSheet.Cells(fileNameRow, 2).Value = "Imported"
        Next
    End With
End Sub