Excel精英培训网

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

[已解决]对D列到Q列从第4行开始以下的数据转成万元

[复制链接]
发表于 2015-3-15 09:53 | 显示全部楼层 |阅读模式
我要对D列到Q列从第4行开始以下的数据转成万元(即单元格数值除以10000),只对有数据的行进行转化,有数据的行数不确定。搜索半天也没搜到合适的,用了其他代码自已修改,如下:
  Sub 化万元 ()
'对D列    row1 = Sheets("本年").Range("a65536").End(xlUp).Row
    arr1 = Sheets("本年").Range("d4:d" & row1)
    For i = 1 To UBound(arr1)
        arr1(i, 1) = Format(arr1(i, 1) / 10000)
    Next i
    Sheets("本年").Range("d4").Resize(UBound(arr1), 1) = arr1

  '对E列
    row2 = Sheets("本年").Range("a65536").End(xlUp).Row
    arr2 = Sheets("本年").Range("e4:e" & row2)
    For i2 = 1 To UBound(arr2)
        arr2(i2, 1) = Format(arr2(i2, 1) / 10000)
    Next i2
    Sheets("本年").Range("e4").Resize(UBound(arr2), 1) = arr2

  '对F列
    row3 = Sheets("本年").Range("a65536").End(xlUp).Row
    arr3 = Sheets("本年").Range("f4:f" & row3)
    For i3 = 1 To UBound(arr3)
        arr3(i3, 1) = Format(arr3(i3, 1) / 10000)
    Next i3
    Sheets("本年").Range("f4").Resize(UBound(arr3), 1) = arr3

'以下还有G、H、I、J、K、L、M、N、O、P、Q列!!!
End sub

我这种写法从D列搞到Q列,万里长征了,崩溃了,两眼直冒金星!请求大神帮简化。还有这种算法也较慢,有没有运算更快的?
最佳答案
2015-3-16 09:32
或者这样,从d列开始定义数组,取当前表最大行为一维数。
  1. Sub 化万元()
  2.     With Sheets("本年")
  3.         r = .UsedRange.Rows.Count
  4.         arr = .Range("d1:Q" & r)
  5.         For c = 1 To 13          'D--Q列
  6.             For i = 4 To UBound(arr)
  7.                 If Len(arr(i, c)) > 0 Then arr(i, c) = Format(arr(i, c) / 10000)
  8.             Next
  9.         Next
  10.         .Range("d1:Q" & r) = arr
  11.     End With
  12. End Sub
复制代码
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2015-3-15 10:08 | 显示全部楼层
  1. Sub 化万元()
  2.     With Sheets("本年")
  3.         r = .[a65536].End(3).Row
  4.         arr = .Range("a1:Q" & r)
  5.         For c = 4 To 17          'D--Q列
  6.             For i = 1 To UBound(arr)
  7.                 If Len(arr(i, c)) > 0 Then arr(i, c) = Format(arr(i, c) / 10000)
  8.             Next
  9.         Next
  10.         .Range("a1:Q" & r) = arr
  11.     End With
  12. End Sub
复制代码
回复

使用道具 举报

发表于 2015-3-15 10:09 | 显示全部楼层
从第4行开始,第6句改为For i = 4 To UBound(arr)
回复

使用道具 举报

 楼主| 发表于 2015-3-15 10:14 | 显示全部楼层
grf1973 发表于 2015-3-15 10:08

谢谢!如果还要对另一个工作表《上年》(格式与《本年》表一样)也进行同样的转化万元,又怎么弄?
回复

使用道具 举报

 楼主| 发表于 2015-3-15 11:02 | 显示全部楼层
grf1973 发表于 2015-3-15 10:08

有不完善的地方,运行后把1-4行内设置的公式,1-3列设置的格式清除了
回复

使用道具 举报

 楼主| 发表于 2015-3-15 12:36 | 显示全部楼层
grf1973 发表于 2015-3-15 10:08

我想.Range("a1:Q" & r) 改成.Range("D1:Q" & r),提示下越边界,能改的话问题应该能解决了,怎么改?
回复

使用道具 举报

发表于 2015-3-16 09:21 | 显示全部楼层
要是另一工作表, With Sheets("本年") 改一下。
  1. Sub 化万元()
  2.     With Sheets("本年")
  3.         For c = 4 To 17          'D--Q列
  4.             r = .Cells(65536, c).End(3).Row     '各列最大行
  5.             arr = .Range(.Cells(4, c), .Cells(r, c))   '各列定义数组
  6.             For i = 1 To UBound(arr)        '非空/10000
  7.                 If Len(arr(i, 1)) > 0 Then arr(i, 1) = arr(i, 1) / 10000
  8.             Next
  9.             .Range(.Cells(4, c), .Cells(r, c)) = arr         '写入
  10.         Next
  11.     End With
  12. End Sub
复制代码
回复

使用道具 举报

发表于 2015-3-16 09:32 | 显示全部楼层    本楼为最佳答案   
或者这样,从d列开始定义数组,取当前表最大行为一维数。
  1. Sub 化万元()
  2.     With Sheets("本年")
  3.         r = .UsedRange.Rows.Count
  4.         arr = .Range("d1:Q" & r)
  5.         For c = 1 To 13          'D--Q列
  6.             For i = 4 To UBound(arr)
  7.                 If Len(arr(i, c)) > 0 Then arr(i, c) = Format(arr(i, c) / 10000)
  8.             Next
  9.         Next
  10.         .Range("d1:Q" & r) = arr
  11.     End With
  12. End Sub
复制代码
回复

使用道具 举报

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

本版积分规则

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

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

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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