我正在尝试创建一个VBA宏,以使用SUMIFS函数将数据从RAW工作表导入工作表表数组。此功能需要循环列出的每个站点的列,并根据SUMIFS设置单元格的值。
但是,遇到一个问题,我认为这与我引用该列的方式有关。
列查找部分应该在第7行中查找包含“总计”的列左侧的列,然后将preCol设置为等于该列号。
我收到错误13:在preCol = .Find("Total", After:="OI7", LookIn:=xlValues).Offset(0, -1).Column
上键入不匹配是有道理的,但是我想不出一种方法来找到一列,然后根据该列的位置将其转换为整数。
任何建议或见解都将不胜感激。
Option Explicit
Sub ImportFile()
'Select import file
On Error GoTo err
Dim importFilePath As String
Dim fileExplorer As FileDialog
Set fileExplorer = Application.FileDialog(msoFileDialogFilePicker)
With fileExplorer
.AllowMultiSelect = False
.Filters.Add "Excel Files", "*.xls; *.xlsx; *.xlsm; *.xlsb", 1
.Show
If .SelectedItems.Count > 0 Then
importFilePath = .SelectedItems.Item(1)
Else
GoTo err
MsgBox "Import cancelled."
End If
End With
'Beginning processes
Application.ScreenUpdating = False
Application.EnableEvents = False
'Defining and setting variables
'Loop variables
Dim i As Integer
Dim j As Integer
Dim s As Integer
'RAW workbook
Dim dataFile As Worksheet
Set dataFile = Workbooks.Open(importFilePath).Sheets("Cons Tx excluding credits")
'Worksheet variables
Dim wsBOS As Worksheet
Set wsBOS = ThisWorkbook.Sheets("FY19 Weekly Boston")
Dim wsMilford As Worksheet
Set wsMilford = ThisWorkbook.Sheets("FY19 Weekly Milford")
Dim wsMansfield As Worksheet
Set wsMansfield = ThisWorkbook.Sheets("FY19 Weekly Mansfield")
Dim wsSSH As Worksheet
Set wsSSH = ThisWorkbook.Sheets("FY19 Weekly SSH")
Dim wsLP As Worksheet
Set wsLP = ThisWorkbook.Sheets("FY19 Weekly Libbey Park")
Dim sheetArray As Variant
sheetArray = Array(wsBOS, wsMilford, wsMansfield, wsSSH, wsLP)
'SUMIF function variables
Dim sumIfRange As Range 'Quantity
Set sumIfRange = dataFile.Range("M:M")
Dim cSiteRange As Range 'Disease site
Set cSiteRange = dataFile.Range("AM:AM")
Dim criteriaSite As Range
Dim cDeptRange As Range 'Department
Set cDeptRange = dataFile.Range("B:B")
Dim criteriaDept As Range
Dim cTherapyRange As Range 'Therapy used
Set cTherapyRange = dataFile.Range("E:E")
Dim criteriaTherapy As Range
Dim c2TherapyRange As Range
Set c2TherapyRange = dataFile.Range("E:E")
Dim criteria2Therapy As Range
Dim cGlandGURange As Range
Set cGlandGURange = dataFile.Range("AM:AM")
Dim criteriaGlandGU As Range
'Insert before column containing "Total"
Dim f As Range
Dim firstAddress As String
For s = LBound(sheetArray) To UBound(sheetArray)
With sheetArray(s)
With .Rows(7).SpecialCells(XlCellType.xlCellTypeConstants, xlTextValues)
Set f = .Find(what:="Total", LookIn:=xlValues, lookat:=xlWhole)
If Not f Is Nothing Then
firstAddress = f.Offset(, 1).Address '<-- offset by one column since f will be shifted one column to the right in subsequent statement
Do
f.EntireColumn.Insert
Set f = .FindNext(f)
Loop While f.Address <> firstAddress
End If
End With
End With
Next s
Dim preCol As Long
With Sheets("FY19 Weekly Boston")
With .Rows(7).SpecialCells(XlCellType.xlCellTypeConstants, xlTextValues)
preCol = .Find("Total", After:="OI7", LookIn:=xlValues).Offset(0, -1).Column
End With
End With
For s = 1 To UBound(sheetArray)
With sheetArray(s)
For i = 8 To 21
Set criteriaDept = sheetArray(s).Cells("B7")
Set criteriaSite = sheetArray(s).Cells(i, 2)
Set criteriaTherapy = sheetArray(s).Cells("C6")
Set criteria2Therapy = sheetArray(s).Cells("C7")
sheetArray.Cells(i, preCol) = Application.WorksheetFunction.SumIfs(sumIfRange, cSiteRange, criteriaSite, cDeptRange, criteriaDept, cTherapyRange, criteriaTherapy) + Application.WorksheetFunction.SumIfs(sumIfRange, cSiteRange, criteriaSite, cDeptRange, criteriaDept, c2TherapyRange, criteria2Therapy)
Next i
End With
Next s
Set criteriaDept = Nothing
Set criteriaSite = Nothing
Set criteriaTherapy = Nothing
Set criteria2Therapy = Nothing
'Ending processes
Application.ScreenUpdating = True
Application.EnableEvents = True
err:
Exit Sub
End Sub
答案 0 :(得分:1)
类似这样的东西:
Dim f As Range, preCol As Long
With ActiveSheet.Rows(7)
'Range() below is *relative* to the With range
Set f = .Find("Total", After:=.Range("OI1"), LookIn:=xlValues)
If Not f Is Nothing Then
preCol = f.Column - 1
Else
'handle missing column header
End If
End With
Debug.Print preCol