在VBA中过滤Excel多维数组

Question

我需要像多维数组一样获取数据的数量和详细信息。 问题是我需要用VBA制作，因此只需单击一下即可。

我需要根据日期来获取数据，每个星期二我都必须根据新的Excel来获取数据。

从该文件中，我需要：

1. 删除空白日期（D，E，F列）
2. 计算最早的日期到当前的星期二之间的行数减去9天
3. 计算当前星期二减去8天和当前星期二减去3天之间的行数
4. 重新组合一些数据
5. 单击时，显示详细信息

为了说明这一点，我需要过滤一个像这样的数组

ColA         ColB        ColC    ColD   ColE    ColF     ColG       Details
PIM12          I          00                    Asia
PIM12          I          00                    Asia
PIM12          I          03      03      03      15      MAT        Asia
PIM12          I          01      11      03      15      DAP        Asia
PIM12          I          01      24      02      15      APM        Asia
PIM12          I          00                                         Europe
PIM12          I          00                                         Europe
PIM12          I          01      24      02      15      MAT        USA
PIM12          I          00                                         USA
PIM12          I          02      17      02      15      JOU        USA
PIM12          I          03      05      03      15      APM        Australia
PIM12          I          00                                         Australia
PIMDE          I          00                                         Australia
PIMDE          I          00                                         Australia
PIMDE          I          21      24      02      15      JOU        
PIMDE          I          21      24      02      15      JOU        
PIMDE          I          07      03      03      15      JOU        
PIMDE          I          21      24      02      15      JOU    
..........

要获得像这样的多维数组：

Centre  FROM X TO DAY - 9   FROM DAY -8 TO DAY - 3
DECINES       3                     2
    Asia      1                     1
    Europe    2                     1
OULLINS       3                     0
    Africa    3                     0
RILLIEUX      3                     4
    Asia      1                     2
    Australia 1                     1
    USA       1                     1
VENISSIEUX    6                     5
    Asia      1                     1
    Australia 1                     3
    Europe    2                     1
    USA       2                     0
Total         15                    22

从x到day-8代表从过滤器中找到的第一个日期到今天（假设我们是星期二）的日期减去8天的所有数据。 从第3天开始也是如此。

另一个例证可能是：

from x         day -9        day -3
======data========>
                  ======data=====>

---

我启动了这段代码，但是我错了，我需要重新组合这些代码：

• “ PIM12”，“ PTL12”，“ PIC12”并将其重命名为RILLIEUX
• “ PIM52”，“ PTL52”，“ PIC52”重命名为OULLINS
• “ PIMSE”，“ PTL31”，“ PIC31”重命名为VENISSIEUX
• “ PIMDE”，“ PTLDE”，“ PICDE”重命名为DECINES

---

Option Explicit
Sub VerifLignesAvecAutoFilter()

Dim DataBlock As Range, Dest As Range
Dim LastRow As Long, LastCol As Long
Dim FeuilOne, FeuilTwo, FeuilThree As Worksheet
Dim finalRow As Long
Dim i, c, idx As Integer
Dim madate, xlDate As Date
Dim xlDay, xlMonth, xlYear As String
Dim realDay, realMonth, realYear As String
Dim dataRillieux, dataOullins, dataVenissieux, dataDecines As Integer
Dim dataRillieuxX, dataOullinsX, dataVenissieuxX, dataDecinesX As Integer


'variable qui referencent les trois feuilles dont nous avons besoin
Set FeuilOne = ThisWorkbook.Worksheets("data")
Set FeuilTwo = ThisWorkbook.Worksheets("Feuil2")
Set FeuilThree = ThisWorkbook.Worksheets("Feuil3")


finalRow = ThisWorkbook.Worksheets("Feuil2").Range("A1").End(xlUp).row

idx = 0
dataRillieux = 0
dataRillieuxX = 0
dataOullins = 0
dataOullinsX = 0
dataVenissieux = 0
dataVenissieuxX = 0
dataDecines = 0
dataDecinesX = 0

madate = CDate("24/02/2015")

realDay = Format(Date, "dd")
realMonth = Format(Date, "mm")
realYear = Format(Date, "yy")

realMonth = Format(DateAdd("m", -1, Date), "mm")

With FeuilTwo.Cells.ClearContents
End With

With FeuilThree.Cells.ClearContents
End With

Set Dest = FeuilTwo.Cells(1, 1) '<~ c'est dans cette feuille que nous mettons les données

'identification du block de données dans lequel nous appliquerons le autofilter
With FeuilOne
    LastRow = .Range("A" & .Rows.Count).End(xlUp).row
    LastCol = .Cells(1, .Columns.Count).End(xlToLeft).column
    Set DataBlock = .Range(.Cells(1, 1), .Cells(LastRow, LastCol))
End With

'application des autofilter à la column D,E,F
With DataBlock
    .AutoFilter Field:=1, Criteria1:=Array("*PIM*", "*PIC*", "*PTL*") 'column A
    .AutoFilter Field:=6, Criteria1:="=" & realYear 'column F represent year
    .AutoFilter Field:=5, Criteria1:="<=*" & realMonth 'column E represent month
    .AutoFilter Field:=4, Criteria1:="<" & madate
    'on copie ce qui a été filtré dans le Dest
    .SpecialCells(xlCellTypeVisible).Copy Destination:=Dest
End With




For Each c In FeuilTwo.Range("A:A")
    Select Case c

        '********** RILLIEUX **********
        Case "PIM12", "PTL12", "PIC12"
        xlDay = FeuilTwo.Cells(idx, "F").Value
        xlMonth = FeuilTwo.Cells(idx, "E").Value
        xlYear = FeuilTwo.Cells(idx, "D").Value

        xlDate = CDate(xlDay + "/" + xlMonth + "/" + xlYear)

        If xlDate > madate - 3 Then
            GoTo continuer
        ElseIf xlDate >= madate - 8 And xlDate <= madate - 3 Then
         dataRillieuxX = dataRillieux + 1
        End If

        FeuilThree.Range("C2") = dataRillieux
        FeuilThree.Range("B2") = dataRillieuxX

        '********** OULLINS **********
        Case "PIM52", "PTL52", "PIC52"

        '********** VENISSIEUX **********
        Case "PIMSE", "PTL31", "PIC31"

        '********** DECINES **********
        Case "PIMDE", "PTLDE", "PICDE"

    End Select
continuer:
    idx = idx + 1
Next c


'on enleve l'autofilter
With FeuilOne
    .AutoFilterMode = False
    If .FilterMode = True Then .ShowAllData
End With

End Sub

如果有任何VBA专家可以帮助我，将不胜感激。