引用列以供以后在VBA中循环使用

时间:2019-03-06 17:20:29

标签: excel vba

我正在尝试创建一个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

1 个答案:

答案 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