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

我有一个macros,我使用的是5岁以上,我第一次开始在32位Excel 2007中使用它,但我不再使用Excel 2007,而是使用Excel 2013,并且此macros不再正常工作…

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

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


主要问题是…

我如何使我的macros兼容,以便它可以与任何区域设置pipe理如何让macros只能与英国区域设置(date)…


该macros应该使用自动筛选器来匹配两列以查找匹配的行,然后将数据从一张纸导出到另一张纸上。 我已经包含了一个名为“ RUSHEET(CORRECT) ”的表,它具有输出应该看起来像什么。

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

有问题的macros是:

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 

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

在这里输入图像说明

但是,如果我忽略在循环开始时closures自动filter,我可以产生你描述的错误。

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

因此,确保在运行macros之前,表单的filter已closures。 否则,你会得到不希望的输出(没有输出!),这被On Error Resume Next所掩盖。

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

在这里输入图像说明

我对你的代码唯一的其他mod是select你遇到的一个范围的两行:

wsList.Activate wsList.Range(“AK:AO”)。select