Excel精英培训网

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

[已解决][求助]请老师们帮忙修改 VBA代码

[复制链接]
发表于 2009-10-19 08:34 | 显示全部楼层 |阅读模式

请老师们帮忙修改代码,以实现一次统计到A列最末行的数据···

原代码只能统计到30行(每30行统计一次)
我要改成只统计一次A列的所有数据,,谢谢老师们···


请看附件

bdRw7zaO.rar (57.48 KB, 下载次数: 10)
发表于 2009-10-19 08:42 | 显示全部楼层

Sub kln()
Dim arr(1 To 3, 0 To 9)
For a1 = 0 To 9
arr(1, a1) = a1
arr(2, a1) = a1
arr(3, a1) = a1
Next

For i = 1 To [a65536].End(xlUp).Row
arr(1, Mid(Cells(i, 1), 1, 1)) = arr(1, Mid(Cells(i, 1), 1, 1)) + 10
arr(2, Mid(Cells(i, 1), 2, 1)) = arr(2, Mid(Cells(i, 1), 2, 1)) + 10
arr(3, Mid(Cells(i, 1), 3, 1)) = arr(3, Mid(Cells(i, 1), 3, 1)) + 10
Next
i = i - 1
    Cells(i - 2, 3).Resize(3, 10) = arr
      For a2 = 2 To 0 Step -1
         Set aa = Cells(i - a2, 3).Resize(1, 10)
          aa.Sort Key1:=Cells(i - a2, 3), Order1:=xlDescending, Header:=xlGuess _
            , OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, _
          SortMethod:=xlStroke, DataOption1:=xlSortNormal
        For Each a In aa
           a.Value = Left(a, 1)
        Next
     Next
     For a1 = 0 To 9
        arr(1, a1) = a1
        arr(2, a1) = a1
        arr(3, a1) = a1
    Next
End Sub

回复

使用道具 举报

 楼主| 发表于 2009-10-19 12:25 | 显示全部楼层

兰色 老师好

运算后 结果不对啊。。。

怎么统计出来 结果 都不超十呀,。。

8千多组数据,怎么说都要过百,甚至过千啊

回复

使用道具 举报

发表于 2009-10-19 15:15 | 显示全部楼层

Sub kln()
Dim arr(1 To 3, 0 To 9)
For a1 = 0 To 9
arr(1, a1) = a1
arr(2, a1) = a1
arr(3, a1) = a1
Next

For i = 1 To [a65536].End(xlUp).Row
arr(1, Mid(Cells(i, 1), 1, 1)) = arr(1, Mid(Cells(i, 1), 1, 1)) + 10
arr(2, Mid(Cells(i, 1), 2, 1)) = arr(2, Mid(Cells(i, 1), 2, 1)) + 10
arr(3, Mid(Cells(i, 1), 3, 1)) = arr(3, Mid(Cells(i, 1), 3, 1)) + 10

Next

Cells(1, 3).Resize(3, 10) = arr
For a2 = 1 To 3
Set aa = Cells(a2, 3).Resize(1, 10)
aa.Sort Key1:=Cells(a2, 3), Order1:=xlDescending, Header:=xlGuess _
        , OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, _
        SortMethod:=xlStroke, DataOption1:=xlSortNormal
For Each a In aa
'a.Value = Left(a, 1)
a.Value = Right(a, 1)
Next
Next
End Sub

你这个不就是想统计每个数字出现的频率的顺序么

所以我认为你的那个left 应该是 right

回复

使用道具 举报

 楼主| 发表于 2009-10-19 15:37 | 显示全部楼层

QUOTE:
以下是引用knifefox在2009-10-19 15:15:00的发言:

Sub kln()
Dim arr(1 To 3, 0 To 9)
For a1 = 0 To 9
arr(1, a1) = a1
arr(2, a1) = a1
arr(3, a1) = a1
Next

For i = 1 To [a65536].End(xlUp).Row
arr(1, Mid(Cells(i, 1), 1, 1)) = arr(1, Mid(Cells(i, 1), 1, 1)) + 10
arr(2, Mid(Cells(i, 1), 2, 1)) = arr(2, Mid(Cells(i, 1), 2, 1)) + 10
arr(3, Mid(Cells(i, 1), 3, 1)) = arr(3, Mid(Cells(i, 1), 3, 1)) + 10

Next

Cells(1, 3).Resize(3, 10) = arr
For a2 = 1 To 3
Set aa = Cells(a2, 3).Resize(1, 10)
aa.Sort Key1:=Cells(a2, 3), Order1:=xlDescending, Header:=xlGuess _
        , OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, _
        SortMethod:=xlStroke, DataOption1:=xlSortNormal
For Each a In aa
'a.Value = Left(a, 1)
a.Value = Right(a, 1)
Next
Next
End Sub

你这个不就是想统计每个数字出现的频率的顺序么

所以我认为你的那个left 应该是 right

嘻嘻

你说对了···

只是也没能得到我想要的结果啊、、、、

我这里A列有 8374 组数据,统计下来结果怎么可能只有个位数的?

回复

使用道具 举报

发表于 2009-10-19 16:05 | 显示全部楼层

你把那个right那行注释掉就行了

回复

使用道具 举报

 楼主| 发表于 2009-10-19 23:12 | 显示全部楼层

老师好

是这样吧?

Sub kln()
Dim arr(1 To 3, 0 To 9)
For a1 = 0 To 9
arr(1, a1) = a1
arr(2, a1) = a1
arr(3, a1) = a1
Next

For i = 1 To [a65536].End(xlUp).Row
arr(1, Mid(Cells(i, 1), 1, 1)) = arr(1, Mid(Cells(i, 1), 1, 1)) + 10
arr(2, Mid(Cells(i, 1), 2, 1)) = arr(2, Mid(Cells(i, 1), 2, 1)) + 10
arr(3, Mid(Cells(i, 1), 3, 1)) = arr(3, Mid(Cells(i, 1), 3, 1)) + 10

Next

Cells(1, 3).Resize(3, 10) = arr
For a2 = 1 To 3
Set aa = Cells(a2, 3).Resize(1, 10)
aa.Sort Key1:=Cells(a2, 3), Order1:=xlDescending, Header:=xlGuess _
        , OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, _
        SortMethod:=xlStroke, DataOption1:=xlSortNormal
For Each a In aa
a.Value = Right(a, 1)
Next
Next
End Sub

若是这样,结果还是不能计算出正确结果的。。。

回复

使用道具 举报

发表于 2009-10-20 10:50 | 显示全部楼层

Sub kln()
Dim arr(1 To 3, 0 To 9)
For a1 = 0 To 9
arr(1, a1) = a1
arr(2, a1) = a1
arr(3, a1) = a1
Next

For i = 1 To [a65536].End(xlUp).Row
arr(1, Mid(Cells(i, 1), 1, 1)) = arr(1, Mid(Cells(i, 1), 1, 1)) + 10
arr(2, Mid(Cells(i, 1), 2, 1)) = arr(2, Mid(Cells(i, 1), 2, 1)) + 10
arr(3, Mid(Cells(i, 1), 3, 1)) = arr(3, Mid(Cells(i, 1), 3, 1)) + 10

Next

Cells(1, 3).Resize(3, 10) = arr
For a2 = 1 To 3
Set aa = Cells(a2, 3).Resize(1, 10)
aa.Sort Key1:=Cells(a2, 3), Order1:=xlDescending, Header:=xlGuess _
        , OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, _
        SortMethod:=xlStroke, DataOption1:=xlSortNormal
Next
End Sub

回复

使用道具 举报

 楼主| 发表于 2009-10-21 09:22 | 显示全部楼层

嗯。。。。这次对了。。。

能不能再修改一下把答案放到数据最后的三行里呢?

例子的最后的数据在8374行,

能不能把计算结果放在8372,8373,8374这三行呢

万分感谢

回复

使用道具 举报

发表于 2009-10-21 14:15 | 显示全部楼层    本楼为最佳答案   

Sub kln()
Dim arr(1 To 3, 0 To 9)
For a1 = 0 To 9
arr(1, a1) = a1
arr(2, a1) = a1
arr(3, a1) = a1
Next

For i = 1 To [a65536].End(xlUp).Row
arr(1, Mid(Cells(i, 1), 1, 1)) = arr(1, Mid(Cells(i, 1), 1, 1)) + 10
arr(2, Mid(Cells(i, 1), 2, 1)) = arr(2, Mid(Cells(i, 1), 2, 1)) + 10
arr(3, Mid(Cells(i, 1), 3, 1)) = arr(3, Mid(Cells(i, 1), 3, 1)) + 10

Next

Cells(i-4, 3).Resize(3, 10) = arr
For a2 = 1 To 3
Set aa = Cells(a2, 3).Resize(1, 10)
aa.Sort Key1:=Cells(a2, 3), Order1:=xlDescending, Header:=xlGuess _
        , OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, _
        SortMethod:=xlStroke, DataOption1:=xlSortNormal
Next
End Sub

回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 05:05 , Processed in 0.314840 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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