[已解决]数据过滤求助

jk0932 · 发表于 2016-6-17 18:30

本帖最后由 jk0932 于 2016-6-23 09:33 编辑

如附件所示：
输入表为原数据：
输出为结果

过滤条件需要设置；解释如下：
指定条件列需要筛选项目所在列
指定筛选项目：为指定条件列包含的内容
指定关联列：指定关联项目所在的列
指定关联项目：指定关联项目名称；

过滤条件表示列：
筛选项目在输入表的D列名字为：查水表
筛选出的结果为查水表所在的行，和它相关联的指定列在C列（最近一条），名称为：酒店订单

输出
拷贝所有过滤结果到表：输出结果
计算结果：过滤条件所对应的A列时间减去关联项目对应的A列时间（查看具体公式如表内）
整体平均值：E列平均值（设置格式为时间格式）

最佳答案

月排行榜 / 总排行榜

老司机带带我

2016-6-18 18:08

Sub 过滤()
Dim n$, arr, brr, crr(), g&, z&, gt$, zt$, x&, n1&, d As Double
With Sheet1
n = .Cells(.Rows.Count, 1).End(xlUp).Row
arr = .Range("A2:D" & n)
End With
brr = Sheet3.Range("A2:D2")
z = Asc(brr(1, 1)) - 64
zt = brr(1, 2)
g = Asc(brr(1, 3)) - 64
gt = brr(1, 4)
ReDim Preserve crr(1 To 5, 1 To 1)
x = 1
For i = 1600 To n - 1
If arr(i, g) = gt Then
For j = 1 To 4
crr(j, x) = arr(i, j)
Next
ElseIf arr(i, z) = zt Then
x = x + 1
ReDim Preserve crr(1 To 5, 1 To x)
For j = 1 To 4
crr(j, x) = arr(i, j)
Next
d = crr(1, x) - crr(1, x - 1)
crr(5, x) = d
x = x + 1
ReDim Preserve crr(1 To 5, 1 To x)
End If
Next
n1 = UBound(Application.Index(crr, 2))
Sheet2.Range("A2:E" & n1) = Application.WorksheetFunction.Transpose(crr)
End Sub

复制代码

跳转到最佳答案楼层

老司机带带我 · 发表于 2016-6-18 18:08

Sub 过滤()
Dim n$, arr, brr, crr(), g&, z&, gt$, zt$, x&, n1&, d As Double
With Sheet1
n = .Cells(.Rows.Count, 1).End(xlUp).Row
arr = .Range("A2:D" & n)
End With
brr = Sheet3.Range("A2:D2")
z = Asc(brr(1, 1)) - 64
zt = brr(1, 2)
g = Asc(brr(1, 3)) - 64
gt = brr(1, 4)
ReDim Preserve crr(1 To 5, 1 To 1)
x = 1
For i = 1600 To n - 1
If arr(i, g) = gt Then
For j = 1 To 4
crr(j, x) = arr(i, j)
Next
ElseIf arr(i, z) = zt Then
x = x + 1
ReDim Preserve crr(1 To 5, 1 To x)
For j = 1 To 4
crr(j, x) = arr(i, j)
Next
d = crr(1, x) - crr(1, x - 1)
crr(5, x) = d
x = x + 1
ReDim Preserve crr(1 To 5, 1 To x)
End If
Next
n1 = UBound(Application.Index(crr, 2))
Sheet2.Range("A2:E" & n1) = Application.WorksheetFunction.Transpose(crr)
End Sub

复制代码

		自动登录	找回密码
密码			注册