Excel VBA總結某一列的最後一個單元格到'總結'工作表

Question

我試圖使用下面的代碼，我發現互聯網總結工作表（發票）到「總結表」。我試圖修改它以選擇F列（總金額）中代表每個發票總額的最後一個單元格失敗。

F列中的總計根據銷售的物品有不同的行數。

請幫我更新的代碼把它列選擇其值最後一個單元格總量F.

謝謝！

Sub Summary_All_Worksheets_With_Formulas() 
Dim Sh As Worksheet 
Dim Newsh As Worksheet 
Dim myCell As Range 
Dim ColNum As Integer 
Dim RwNum As Long 
Dim Basebook As Workbook 

With Application 
    .Calculation = xlCalculationManual 
    .ScreenUpdating = False 
End With 

'Delete the sheet "Summary-Sheet" if it exist 
Application.DisplayAlerts = False 
On Error Resume Next 
ThisWorkbook.Worksheets("Summary-Sheet").Delete 
On Error GoTo 0 
Application.DisplayAlerts = True 

'Add a worksheet with the name "Summary-Sheet" 
Set Basebook = ThisWorkbook 
Set Newsh = Basebook.Worksheets.Add 
Newsh.Name = "Summary-Sheet" 

'The links to the first sheet will start in row 2 
RwNum = 1 

For Each Sh In Basebook.Worksheets 
    If Sh.Name <> Newsh.Name And Sh.Visible Then 
     ColNum = 1 
     RwNum = RwNum + 1 
     'Copy the sheet name in the A column 
     Newsh.Cells(RwNum, 1).Value = Sh.Name 

     For Each myCell In Sh.Range("A1,A2,C3,E3,C4,E4,C5,E5") '<--Change the range 
      ColNum = ColNum + 1 
      Newsh.Cells(RwNum, ColNum).Formula = _ 
      "='" & Sh.Name & "'!" & myCell.Address(False, False) 
     Next myCell 

    End If 
Next Sh 

Newsh.UsedRange.Columns.AutoFit 

With Application 
    .Calculation = xlCalculationAutomatic 
    .ScreenUpdating = True 
End With 
End Sub 

Answer 1

您不需要遍歷單元格來查找「總金額」。我修改了部分代碼如下：

If Sh.Name <> Newsh.Name And Sh.Visible Then 
     ColNum = 1 
     RwNum = RwNum + 1 
     'Copy the sheet name in the A column 
     Newsh.Cells(RwNum, 1).Value = Sh.Name 

     'put this declaration on top 
     Dim CellsArray() As String 
     Dim RangeString As String 
     Dim intCount As Integer 

     'your collection of ranges 
     RangeString = "A1,A2,C3,E3,C4,E4,C5,E5" 

     'split them into array 
     CellsArray = Split(RangeString, ",") 

     'loop through your array 
     For intCount = LBound(CellsArray) To UBound(CellsArray) 

     ColNum = ColNum + 1 
     Newsh.Cells(RwNum, ColNum).Formula = _ 
     "='" & Sh.Name & "'!" & CellsArray(intCount) '<- access each range in array 

     Next intCount 


     'Find last row in the column: "Total Amount" 
     LastRow = Sh.Cells(Sh.Rows.Count, "F").End(xlUp).Row 

     'Assign that cell to myCell 
     Set myCell = Sh.Range("F" & LastRow) 

     'total 
     ColNum = ColNum + 1 
     Newsh.Cells(RwNum, ColNum).Formula = _ 
     "='" & Sh.Name & "'!" & myCell.Address(False, False) 

    End If 

編輯：我添加了循環週期中間的F列可以這樣訪問請求