Excel精英培训网

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

[已解决]补上对应行的数字。

[复制链接]
发表于 2015-3-24 12:53 | 显示全部楼层 |阅读模式
本帖最后由 excelpxfans001 于 2015-3-24 13:46 编辑

补上对应行的数字。
最佳答案
2015-3-24 13:27
代码可以简化一点:
  1. Sub tt()
  2.     arr = Sheet1.[a1].CurrentRegion
  3.     ReDim brr(1 To 10000, 1 To 2)
  4.     For i = 1 To UBound(arr)
  5.         If Len(arr(i, 1)) = 0 Then arr(i, 1) = arr(i - 1, 1)
  6.         x = arr(i, 2)
  7.         If InStr(x, "分") > 0 Then     '含“分”
  8.             k = Val(Split(x, "分")(1))
  9.         ElseIf InStr(x, "付") > 0 Then        '含“付”
  10.             y = StrReverse(x)        '字符串反转
  11.             k = Val(Split(y, "付")(1))
  12.             k = Val(StrReverse(k))        '字符串反转(两位数以上有用,如31变成13)
  13.             x = Replace(x, "*" & k & "付", "")        '去掉“*3付”
  14.         Else
  15.             k = 1
  16.         End If
  17.         If k >= 1 Then
  18.             For j = 1 To k
  19.                 n = n + 1: brr(n, 1) = arr(i, 1): brr(n, 2) = x
  20.             Next
  21.         End If
  22.     Next
  23.     [d1].Resize(n, 2) = brr
  24. End Sub
复制代码

xxtt.rar

4.7 KB, 下载次数: 10

发表于 2015-3-24 13:22 | 显示全部楼层
  1. Sub tt()
  2.     arr = Sheet1.[a1].CurrentRegion
  3.     ReDim brr(1 To 10000, 1 To 2)
  4.     For i = 1 To UBound(arr)
  5.         If Len(arr(i, 1)) = 0 Then arr(i, 1) = arr(i - 1, 1)
  6.         x = arr(i, 2)
  7.         If InStr(x, "分") > 0 Then     '含“分”
  8.             k = Val(Split(x, "分")(1))
  9.             If k > 1 Then
  10.                 For j = 1 To k
  11.                     n = n + 1: brr(n, 1) = arr(i, 1): brr(n, 2) = x
  12.                 Next
  13.             End If
  14.         ElseIf InStr(x, "付") > 0 Then        '含“付”
  15.             y = StrReverse(x)        '字符串反转
  16.             k = Val(Split(y, "付")(1))
  17.             k = Val(StrReverse(k))        '字符串反转(两位数以上有用,如31变成13)
  18.             x = Replace(x, "*" & k & "付", "")        '去掉“*3付”
  19.             If k > 1 Then
  20.                 For j = 1 To k
  21.                     n = n + 1: brr(n, 1) = arr(i, 1): brr(n, 2) = x
  22.                 Next
  23.             End If
  24.         Else
  25.             n = n + 1: brr(n, 1) = arr(i, 1): brr(n, 2) = x
  26.         End If
  27.     Next
  28.     [d1].Resize(n, 2) = brr
  29. End Sub
复制代码

xxtt.rar

10.89 KB, 下载次数: 5

回复

使用道具 举报

发表于 2015-3-24 13:27 | 显示全部楼层    本楼为最佳答案   
代码可以简化一点:
  1. Sub tt()
  2.     arr = Sheet1.[a1].CurrentRegion
  3.     ReDim brr(1 To 10000, 1 To 2)
  4.     For i = 1 To UBound(arr)
  5.         If Len(arr(i, 1)) = 0 Then arr(i, 1) = arr(i - 1, 1)
  6.         x = arr(i, 2)
  7.         If InStr(x, "分") > 0 Then     '含“分”
  8.             k = Val(Split(x, "分")(1))
  9.         ElseIf InStr(x, "付") > 0 Then        '含“付”
  10.             y = StrReverse(x)        '字符串反转
  11.             k = Val(Split(y, "付")(1))
  12.             k = Val(StrReverse(k))        '字符串反转(两位数以上有用,如31变成13)
  13.             x = Replace(x, "*" & k & "付", "")        '去掉“*3付”
  14.         Else
  15.             k = 1
  16.         End If
  17.         If k >= 1 Then
  18.             For j = 1 To k
  19.                 n = n + 1: brr(n, 1) = arr(i, 1): brr(n, 2) = x
  20.             Next
  21.         End If
  22.     Next
  23.     [d1].Resize(n, 2) = brr
  24. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2015-3-24 13:45 | 显示全部楼层
grf1973 发表于 2015-3-24 13:27
代码可以简化一点:

感谢非常!!!
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 17:55 , Processed in 0.375976 second(s), 8 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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