Excel精英培训网

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

[已解决]能不能修改下代码?

[复制链接]
发表于 2016-1-24 13:54 | 显示全部楼层 |阅读模式
本帖最后由 dsfada 于 2016-1-28 14:11 编辑

能不能修改下原代码,执行程序后达到表2的效果,B C D E G列取最下面的一个数据,到I列最后一行结束
最佳答案
2016-1-25 13:11
  1. Sub text()
  2.     s = "shuju"
  3.     On Error Resume Next
  4.     arr = Range("b10:i" & [i65536].End(3).Row)
  5.     For j = 1 To UBound(arr, 2) - 1
  6.         xstr = ""
  7.         For i = 1 To UBound(arr)
  8.             If arr(i, j) <> "" Then xstr = arr(i, j)
  9.             If arr(i, UBound(arr, 2)) <> "" Then
  10.                 If j = 1 Then
  11.                     p = p + 1
  12.                     arr(i, j) = Val(xstr) + p
  13.                 ElseIf j = 7 Then
  14.                     k = k + 1
  15.                     m = (k - 1) \ 2 + 1
  16.                     n = (k - 1) Mod 2 + 1
  17.                     arr(i, j) = s & m & n
  18.                 Else
  19.                     arr(i, j) = xstr
  20.                 End If
  21.             End If
  22.         Next
  23.     Next
  24.     Range("b10:i" & [i65536].End(3).Row) = arr
  25. End Sub
复制代码
发表于 2016-1-24 15:16 | 显示全部楼层
回复

使用道具 举报

发表于 2016-1-25 13:11 | 显示全部楼层    本楼为最佳答案   
  1. Sub text()
  2.     s = "shuju"
  3.     On Error Resume Next
  4.     arr = Range("b10:i" & [i65536].End(3).Row)
  5.     For j = 1 To UBound(arr, 2) - 1
  6.         xstr = ""
  7.         For i = 1 To UBound(arr)
  8.             If arr(i, j) <> "" Then xstr = arr(i, j)
  9.             If arr(i, UBound(arr, 2)) <> "" Then
  10.                 If j = 1 Then
  11.                     p = p + 1
  12.                     arr(i, j) = Val(xstr) + p
  13.                 ElseIf j = 7 Then
  14.                     k = k + 1
  15.                     m = (k - 1) \ 2 + 1
  16.                     n = (k - 1) Mod 2 + 1
  17.                     arr(i, j) = s & m & n
  18.                 Else
  19.                     arr(i, j) = xstr
  20.                 End If
  21.             End If
  22.         Next
  23.     Next
  24.     Range("b10:i" & [i65536].End(3).Row) = arr
  25. End Sub
复制代码

附件.rar

10.11 KB, 下载次数: 10

回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 12:50 , Processed in 1.251312 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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