首页 文章

Excel VBA将某些列的最后一个单元格汇总到'summary'工作表

提问于
浏览 次
-1

我试图使用下面的代码找到Internet，将工作表（发票）汇总到“摘要表”中 . 我没有成功修改它以选择F列（总金额）中的最后一个单元格，它代表每张发票的总和 .

F列中的总数根据销售的商品而有不同的行号 .

Please help me in updating code to it select total amount from last cell having value in column 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
excel vba excel-vba

1 回答

  • 0

    您不需要遍历单元格来查找“总金额” . 我修改了部分代码，如下所示：

    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

    编辑：我根据请求在中间添加了循环周期

    回复于

相关问题