过滤在Excel中的multidimensional array
我需要像multidimensional array一样获取数据的数量和细节。 问题是我需要使用VBA，所以它只有一个点击。
我需要根据date获取数据，每个星期二我都要根据新的excel获取数据。
从那个文件我需要：
- 删除空白date（D，E，F列）
- 计算最早的date到当前的星期二减去9天之间的行数
- 计算当前星期二减去8天和当前星期二减去3天之间的行数
- 重新组合一些数据
- 点击，显示细节
为了说明这一点，我需要像这样过滤一个数组
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 .......... 为了得到像这样的multidimensional array：
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到第8天代表从filter中发现的第一个date到今天的date（假设我们是星期二）减去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古鲁可以帮助，我将不胜感激。