Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2243|回复: 2

[已解决]麻烦dsmch老师再看看修改代码。

[复制链接]
发表于 2014-4-26 08:38 | 显示全部楼层 |阅读模式
本帖最后由 left369 于 2014-4-26 09:39 编辑

不好意思,老师。对代码不懂。麻烦dsmch老师再看看修改代码。
最佳答案
2014-4-26 09:09
Sub Macro1()
Dim arr, brr, i&, j%, s&, x%
arr = Range("b33").CurrentRegion
ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2) - 1)
y = UBound(arr) '数组最后一行
For j = 2 To UBound(arr, 2)
    x = arr(y, j): s = 0
    For i = y - 2 To 1 Step -1 '倒数第三行循环
        If arr(i, j) = x Then s = s + 1: brr(s, j - 1) = arr(i + 2, j)
    Next
Next
Cells(y + 36, 2).Resize(UBound(brr), UBound(brr, 2)) = brr
End Sub

代码.zip

62.33 KB, 下载次数: 9

发表于 2014-4-26 09:09 | 显示全部楼层    本楼为最佳答案   
Sub Macro1()
Dim arr, brr, i&, j%, s&, x%
arr = Range("b33").CurrentRegion
ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2) - 1)
y = UBound(arr) '数组最后一行
For j = 2 To UBound(arr, 2)
    x = arr(y, j): s = 0
    For i = y - 2 To 1 Step -1 '倒数第三行循环
        If arr(i, j) = x Then s = s + 1: brr(s, j - 1) = arr(i + 2, j)
    Next
Next
Cells(y + 36, 2).Resize(UBound(brr), UBound(brr, 2)) = brr
End Sub
回复

使用道具 举报

发表于 2014-4-26 09:11 | 显示全部楼层
Sub Macro2()
Dim arr, brr, i&, j%, x%
arr = Range("b33").CurrentRegion
ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2) - 1)
y = UBound(arr)
For j = 2 To UBound(arr, 2)
    x = arr(y, j)
    For i = y - 2 To 1 Step -1
        If arr(i, j) = x Then brr(y - i, j - 1) = arr(i + 2, j)
    Next
Next
Cells(y + 36, 2).Resize(UBound(brr), UBound(brr, 2)) = brr
End Sub
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-28 20:28 , Processed in 0.474892 second(s), 9 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表