excel多维数组的vba过滤器
我需要像多维数组一样获取数据的数量和细节。问题是我需要用VBA制作,所以只需点击一次 我需要根据日期获取数据,每周二我必须根据新的excel获取数据 从该文件中,我需要:excel多维数组的vba过滤器,vba,excel,multidimensional-array,Vba,Excel,Multidimensional Array,我需要像多维数组一样获取数据的数量和细节。问题是我需要用VBA制作,所以只需点击一次 我需要根据日期获取数据,每周二我必须根据新的excel获取数据 从该文件中,我需要: 删除空白日期(D、E、F列) 计算从最早日期到当前星期二的行数减去9天 计算当前星期二减去8天和当前星期二减去3天之间的行数 将一些数据重新组合在一起 单击,显示详细信息 为了说明这一点,我需要过滤这样的数组 ColA ColB ColC ColD ColE ColF Co
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天的所有数据。从第二天开始,减去第三天
另一个例子是:
from x day -9 day -3
======data========>
======data=====>
我开始编写此代码,但我错了,我需要重新组合这些代码:
- “PIM12”、“PTL2”、“PIC12”并将其重命名为RILLIEUX
- “PIM52”、“PTL52”、“PIC52”重命名为OULLINS
- “PIMSE”、“PTL31”、“PIC31”更名为VENISSIEUX
- “PIMDE”、“PTLDE”、“PICDE”重命名为DECINES
选项显式
Sub-VerifLignesAvecAutoFilter()
Dim数据块作为范围,目的地作为范围
调暗LastRow和LastCol一样长
Dim FeuilOne、FeuilTwo、FeuilThree作为工作表
暗淡的最后一行
作为整数的Dim i、c、idx
Dim madate,xlDate作为日期
尺寸xlDay、xlMonth、xlYear作为字符串
Dim realDay、realMonth、realYear作为字符串
Dim dataRillieux、dataOullins、dataVenissieux、dataDecines作为整数
Dim dataRillieuxX、Dataoullinxx、dataVenissieuxX、dataDecinesX作为整数
“变数”指的是《特洛伊条约》的内容
Set-FeuilOne=ThisWorkbook.Worksheets(“数据”)
Set FeuilTwo=此工作簿。工作表(“Feuil2”)
设置FeuilThree=ThisWorkbook.Worksheets(“Feuil3”)
finalRow=此工作簿。工作表(“Feuil2”)。范围(“A1”)。结束(xlUp)。行
idx=0
dataRillieux=0
dataRillieuxX=0
dataOullins=0
dataOullinsX=0
dataVenissieux=0
dataVenissieuxX=0
dataDecines=0
dataDecinesX=0
madate=CDate(2015年2月24日)
realDay=格式(日期,“dd”)
realMonth=格式(日期,“mm”)
realYear=格式(日期,“yy”)
realMonth=格式(DateAdd(“m”、-1,日期),“mm”)
使用FeuilTwo.Cells.ClearContents
以
使用FeuilThree.Cells.ClearContents
以
设置Dest=FeuilTwo.Cells(1,1)'madate-3然后
后藤连续器
ElseIf xlDate>=madate-8和xlDate我很难将样本数据与预期结果进行协调。e、 g.PIMDE要么有一个地区(澳大利亚),没有日期,要么没有日期,也没有地区。根据你的描述,它根本不应该出现在报告中。提供的样本数据应该能够产生预期的结果,或者我们只是猜测。你好,吉佩德,谢谢你的帮助。你是真的被嘲笑了,我对数据做了一些修改,使之更加明确,但事实上,我已经把一些事情复杂化了,比如PIMDE,如果至少我有一个日期,并且没有地区(澳大利亚),我需要获取它(计算它)。区域是一个额外的区域,如果有区域,我们可以计算它,如果没有,那么我们为PIMDE获取适合于x到第9天或第9到第3天的数据。任何帮助plz VBA专家?:)在vba专家plz附近需要任何帮助吗
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