[已解决]VBA实现提取单元格内包含某包含某一值的行，大数据处理需要快速计算算法

jk0932 · 发表于 2015-3-3 10:52

本帖最后由 jk0932 于 2015-3-3 11:31 编辑

如下所示某表格为：

比赛项目运动员编号成绩
排球 2021 55
排球 2022 77
排球 2023 33
排球 2024 11
排球 2025 18
排球 2026 37
排球 2027 89
排球 2028 72
排球 2029 59.60714286
羽毛球 2021 61.96428571
羽毛球 2022 64.32142857
羽毛球 2023 66.67857143
羽毛球 2024 69.03571429
羽毛球 2025 71.39285714
网球 2021 73.75
网球 2022 76.10714286
网球 2023 78.46428571
网球 2024 80.82142857
网球 2025 83.17857143
现在想提取运动员编号为2021的行，结果为
比赛项目运动员编号成绩
排球 2021 55
羽毛球 2021 61.96428571
网球 2021 73.75

大数据处理需要快速运算方法。

求解：

最佳答案

月排行榜 / 总排行榜

grf1973

2015-3-3 11:08

Sub 查找()
arr = [a1].CurrentRegion
mr = UBound(arr): mc = UBound(arr, 2)
xm = [g1]: xsearch = [h1]
c = [a1].Resize(1, mc).Find(xm).Column '待查找项目所在的列
brr = arr: n = 1
For i = 2 To mr
If InStr(arr(i, c), xsearch) > 0 Then
n = n + 1
For j = 1 To mc: brr(n, j) = arr(i, j): Next
End If
Next
If n > 1 Then
[f3].Resize(mr, mc).Clear
[f3].Resize(n, mc) = brr
End If
End Sub

复制代码

跳转到最佳答案楼层

grf1973 · 发表于 2015-3-3 11:08

这个最佳答案由 grf1973 给出，感谢 grf1973 的回答。

单击隐藏图章

Sub 查找()
arr = [a1].CurrentRegion
mr = UBound(arr): mc = UBound(arr, 2)
xm = [g1]: xsearch = [h1]
c = [a1].Resize(1, mc).Find(xm).Column '待查找项目所在的列
brr = arr: n = 1
For i = 2 To mr
If InStr(arr(i, c), xsearch) > 0 Then
n = n + 1
For j = 1 To mc: brr(n, j) = arr(i, j): Next
End If
Next
If n > 1 Then
[f3].Resize(mr, mc).Clear
[f3].Resize(n, mc) = brr
End If
End Sub

复制代码

爱疯 · 发表于 2015-3-3 11:20

请勿设置“仅作者可见”，会使得其他朋友无法查看。

jk0932 · 发表于 2015-3-4 21:49

grf1973 发表于 2015-3-3 11:08

编译提示，对象变化或with块变量未设置，如何改进。
我将代码
xm = [g1]
c = [a1].Resize(1, mc).Find(xm).Column    '待查找项目所在的列
改为：
      xm = Application.InputBox("请输入name")
      c = [a1].Resize(1, mc).Find(xm).Column    '待查找项目所在的列
出现问题
编译提示，对象变化或with块变量未设置，如何改进

匿名 *发表于 2015-3-5 00:01* · 发表于 2015-3-5 00:01

学习了，果然有有气氛的

香川群子 · 发表于 2015-3-5 08:19

数据分列、筛选不就可以了吗。

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