Question

问题-我想找到一个特定的标题[例如。工作表中的“不含GST的金额”]并不总是位于同一位置，通常在前5行中。然后，我想将以下1个单元格开始的所有值相加，到具有值的最后一个单元格（有时只有1个单元格，其他的为1000个），然后将sepecial值粘贴到另一个ws中：SourceShtRTI.Range（“ D”＆Last_Row）.Value < / p>

我研究了[VBA - Find a column with a specific header and find sum of all the rows in that column，发现了一些代码，但是我正在努力进行修改以满足自己的特定需求。

    Sub Coles_straight_consolidation()
'Coles Straight Claims Import Macro

Dim SourceWB As Workbook        'Coles Consolidate Promo Claims
Dim SourceShtClm As Worksheet
Dim SourceShtPCD As Worksheet
Dim SourceShtFrml As Worksheet
Dim SourceShtMcrRng As Range
Dim SourceShtFrmlRng As Range
Dim FPath As String             'csv Folder containing raw data export
Dim fCSV As String
Dim wbCSV As Workbook
Dim wbMST As Workbook
Dim FiName As String            'saves promo claims file to new xls file
Dim FiPath As String
Dim StartTime As Double         'time elapsed counter
Dim MinutesElapsed As String
Dim xColIndex As Integer
Dim xRowIndex As Integer
Dim ws As Worksheet
Dim shtSrc As Worksheet
Dim f As Range



    StartTime = Timer           'starts timer - Remember time when macro starts

    NeedForSpeed                'speeds up macro

Set SourceWB = ThisWorkbook     'Set workbook

Set SourceShtMcr = SourceWB.Sheets("Macro")                 'set worksheets
Set SourceShtClm = SourceWB.Sheets("Claim Summary")
Set SourceShtPCD = SourceWB.Sheets("Promo Claim Details")



FPath = ThisWorkbook.Path & "\csv_macro\"                                 'path to CSV files, include the final \
fCSV = Dir(FPath & "*.csv")                                         'start the CSV file listing

    On Error Resume Next
    Do While fCSV <> ""
        Set wbCSV = Workbooks.Open(FPath & fCSV)                'opens workbook

        Last_Row = SourceShtClm.Range("C" & Rows.Count).End(xlUp).Row + 1

        SourceShtClm.Range("C" & Last_Row).Value = Range("G2").Value
        SourceShtClm.Range("F" & Last_Row).Value = Range("L2").Value
        SourceShtClm.Range("G" & Last_Row).Value = Range("Q2").Value
        SourceShtClm.Range("H" & Last_Row).Value = Range("I2").Value
        SourceShtClm.Range("I" & Last_Row).Value = Range("J2").Value

        'Amount Excluding GST


        Set shtSrc = wbCSV.Sheets(1)

        Set f = shtSrc.UsedRange.Find(What:="Amount Excluding GST", After:=shtSrc.Range("A1"), _
                              LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)

        If Not f Is Nothing Then

            Set pRng = shtSrc.Range(f.Offset(1, 0), _
                            shtSrc.Cells(shtSrc.Rows.Count, f.Column).End(xlUp))

        Else

            MsgBox "Required header 'Amount Excluding GST' not found!"

        End If

        SourceShtClm.Range("D" & Last_Row).Value = Application.WorksheetFunction.Sum(pRng)



        'Amount Including GST
        'copy code from above


        wbCSV.Close SaveChanges:=False

        fCSV = Dir                  'ready next CSV


    Loop

    Set wbCSV = Nothing


        SourceWB.Activate
        SourceShtClm.Select
        'Columns("B:J").AutoFit             'Auto fits Columns - update as not all col need auto fit
        ActiveWorkbook.RefreshAll


    MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")        'stops timer - Determine how many seconds code took to run

    MsgBox "This code ran successfully in " & MinutesElapsed, vbInformation & " Make sure to save file as MMM Straights"        'Msg box for elapsed time & Claims consldaited


    ResetSpeed

End Sub

Answer 1

对于这种类型的任务，这是一种很好的通用方法。请注意，通常最好的做法是在尝试访问找到的单元格的属性之前，先确保Find()成功。

Dim shtSrc As Worksheet
Dim f As Range

Set shtSrc = wbCSV.Sheets(1)

Set f = shtSrc.UsedRange.Find(What:="Amount Excluding GST", After:=shtSrc.Range("A1"), _
                              LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)

If Not f Is Nothing Then

    Set pRng = shtSrc.Range(f.Offset(1,0), _
                            shtSrc.Cells(shtSrc.Rows.Count, f.Column).End(xlUp))  

Else

    Msgbox "Required header 'Amount Excluding GST' not found!"

End If

Excel 2013 VBA-查找特定的标头并汇总以下所有值

1 个答案: