Excel 2007和Excel之间的自动过滤兼容性Excel 2010/13涉及日期时,包括示例

时间:2015-02-23 18:36:51

标签: excel vba excel-vba excel-2010 excel-2013

我有一个我正在使用5年以上的宏,我第一次开始在32位Excel 2007中使用它,但我不再使用Excel 2007了,而是使用Excel 2013,这个宏不再正常工作..

  • 在Excel 2007中运行它,区域设置设置为英国或美国=完美工作
  • 在Excel 2010或Excel 2013中运行它,区域设置设置为英国=不起作用
  • 在Excel 2010或Excel 2013中运行它,区域设置设置为United States = Works perfect

问题是,我是英国人,所以我的区域设置设置为英国。


主要问题是......

如何使我的宏兼容,以便它可以使用任何区域设置进行管理如何让宏只能使用英国区域设置(日期)...


宏应该使用自动过滤器匹配两列,以查找匹配的行,然后将数据从一个工作表导出到另一个工作表。我已经包含了一张名为“ RUSHEET(CORRECT)”的表格,它具有输出的样子。

下载:https://www.dropbox.com/s/8edbk8rcp3qumfd/example.xlsm?dl=1

有问题的宏是:

Sub CROSSIMPORT()

    'Optimize'
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
    End With

    Dim wsData As Worksheet:   Set wsData = Sheets("RASHEET")
    Dim wsList As Worksheet:   Set wsList = Sheets("RUSHEET")

    'Loads data into the array from wsList, column A to column E
    'In the beginning, columns B through E may be empty, that is fine
    Dim arrListVal As Variant: arrListVal = wsList.Range("b2", wsList.Cells(Rows.Count, "b").End(xlUp).Offset(0, 43)).Value

    Dim arrIndex As Long
    Dim rngFound As Range

    'Set Range for columns to check (both columns)
    With Intersect(wsData.UsedRange, wsData.Columns("B:C"))

        'UBound(arrListVal, 1) is the upper bound of the first dimension of the array
        'In other words, its the number of rows
        'We'll use arrIndex to go through each row
        'arrIndex starts at 1 because that's the LBound, we already set the array to go from A5 though, so no worries there
        For arrIndex = 1 To UBound(arrListVal, 1)
            'Turn AutoFilter off, test
            If .AutoFilter Then .AutoFilter
            'Filter first array (matching array column 1)
            .AutoFilter 1, arrListVal(arrIndex, 1)
            'Filter second array (matching array column 2)
            .AutoFilter 2, arrListVal(arrIndex, 2)
            On Error Resume Next

            'arrListVal(arrIndex, 1) = row arrIndex in column 1 of the array
            'Attempts to find that value in wsData, column A
            Set rngFound = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
            'Set rngFound = wsData.Columns("B").Find(What:=arrListVal(arrIndex, 1), LookAt:=xlWhole)

            'If it found something, then rngFound will not be nothing
            If Not rngFound Is Nothing Then
                'Found something, fills the other columns of the array
                arrListVal(arrIndex, 36) = wsData.Range("P" & rngFound.Row).Value    'wsList column C should be wsData column I
                arrListVal(arrIndex, 37) = wsData.Range("G" & rngFound.Row).Value    'wsList column D should be wsData column O
                arrListVal(arrIndex, 38) = wsData.Range("E" & rngFound.Row).Value    'wsList column E should be wsData column K
                arrListVal(arrIndex, 39) = wsData.Range("F" & rngFound.Row).Value
                arrListVal(arrIndex, 40) = wsData.Range("X" & rngFound.Row).Value
                arrListVal(arrIndex, 43) = wsData.Range("AF" & rngFound.Row).Value
                arrListVal(arrIndex, 44) = wsData.Range("AG" & rngFound.Row).Value
                'Sets rngFound back to nothing in order to continue the loop through the array
                Set rngFound = Nothing
            Else
            End If

        Next arrIndex

        'Turning Filter Off
        .AutoFilter
    End With

    wsList.Range("B2").Resize(UBound(arrListVal, 1), UBound(arrListVal, 2)).Value = arrListVal

    'De-Optimize'
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
    End With

End Sub

1 个答案:

答案 0 :(得分:0)

这在Excel 2010中按预期工作。我更改输出表只是为了确保:

enter image description here

然而,如果我忽略在循环开始时关闭自动过滤器,我可以产生您描述的错误。

    For arrIndex = 1 To UBound(arrListVal, 1)
        '### Turn AutoFilter off, if it's already on:
        If .AutoFilter Then .AutoFilter

因此,请确保在运行宏之前,已关闭工作表的过滤器。否则,您将获得不受欢迎的输出(无输出!),这会被您滥用On Error Resume Next所掩盖。

除了删除On Error Resume Next语句之外,以下是我未经修改的代码运行时的样子:

enter image description here

我对您的代码所做的唯一其他修改是两行选择您遇到问题的其中一个范围:

wsList.Activate    wsList.Range(" AK:AO&#34)。选择