Excel 2013 VBA - 查找特定的 header 并对以下所有值求和
Excel 2013 VBA - Find specific header and sum all values below
问题 - 我想找到一个特定的 header [例如。 "Amount Excluding GST"] 在工作表中并不总是在同一位置,通常在前 5 行。然后我想将所有值从下面的 1 个单元格开始到最后一个有值的单元格(有时只有 1 个单元格,其他 1000 个单元格)相加,并将这些值特别粘贴到另一个 ws 中:SourceShtClm.Range("D" & Last_Row).值
我研究了 [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
对于此类任务,这是一个很好的通用方法。请注意,在尝试访问找到的单元格的属性之前确保 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
问题 - 我想找到一个特定的 header [例如。 "Amount Excluding GST"] 在工作表中并不总是在同一位置,通常在前 5 行。然后我想将所有值从下面的 1 个单元格开始到最后一个有值的单元格(有时只有 1 个单元格,其他 1000 个单元格)相加,并将这些值特别粘贴到另一个 ws 中:SourceShtClm.Range("D" & Last_Row).值
我研究了 [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
对于此类任务,这是一个很好的通用方法。请注意,在尝试访问找到的单元格的属性之前确保 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