设为首页收藏本站
开启辅助访问

Excel精英培训网

 找回密码
 注册
Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › 求助
数据透视表40+个常用小技巧，让你一次学会！
返回列表 发新帖
查看: 1018|回复: 1

[已解决]求助

[复制链接]
oiufg
发表于 2012-10-12 18:21 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
求助vba Book1.rar (7.28 KB, 下载次数: 5)
excel精英培训的微信平台，每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
回复

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
发表于 2012-10-12 20:08 | 显示全部楼层    本楼为最佳答案   
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
  1. Sub lqxs()
  2. Dim Arr, i&, j&, a(1 To 3), b(1 To 3), r%, Arr1(), x&
  3. Sheet1.Activate
  4. Columns("e:m").ClearContents
  5. Columns("e:m").NumberFormatLocal = "@"
  6. Arr = [c5].CurrentRegion
  7. For j = 1 To 9
  8.     r = 0
  9.     For i = 1 To UBound(Arr)
  10.         For x = 1 To 3
  11.             a(x) = Mid(Arr(i, 1), x, 1)
  12.         Next
  13.         r = r + 1
  14.         ReDim Preserve Arr1(1 To r)
  15.         a(1) = Val(a(1)) + j
  16.         a(1) = Right(a(1), 1)
  17.         Arr1(r) = Join(a, "")
  18.     Next
  19.     For i = 1 To UBound(Arr)
  20.         For x = 1 To 3
  21.             a(x) = Mid(Arr(i, 1), x, 1)
  22.         Next
  23.         r = r + 1
  24.         ReDim Preserve Arr1(1 To r)
  25.         a(2) = Val(a(2)) + j
  26.         a(2) = Right(a(2), 1)
  27.         Arr1(r) = Join(a, "")
  28.     Next
  29.     For i = 1 To UBound(Arr)
  30.         For x = 1 To 3
  31.             a(x) = Mid(Arr(i, 1), x, 1)
  32.         Next
  33.         r = r + 1
  34.         ReDim Preserve Arr1(1 To r)
  35.         a(3) = Val(a(3)) + j
  36.         a(3) = Right(a(3), 1)
  37.         Arr1(r) = Join(a, "")
  38.     Next
  39.     For i = 1 To UBound(Arr)
  40.         For x = 1 To 3
  41.             a(x) = Mid(Arr(i, 1), x, 1)
  42.         Next
  43.         r = r + 1
  44.         ReDim Preserve Arr1(1 To r)
  45.         a(1) = Val(a(1)) + j
  46.         a(1) = Right(a(1), 1)
  47.         a(2) = Val(a(2)) + j
  48.         a(2) = Right(a(2), 1)
  49.         Arr1(r) = Join(a, "")
  50.     Next
  51.     For i = 1 To UBound(Arr)
  52.         For x = 1 To 3
  53.             a(x) = Mid(Arr(i, 1), x, 1)
  54.         Next
  55.         r = r + 1
  56.         ReDim Preserve Arr1(1 To r)
  57.         a(1) = Val(a(1)) + j
  58.         a(1) = Right(a(1), 1)
  59.         a(3) = Val(a(3)) + j
  60.         a(3) = Right(a(3), 1)
  61.         Arr1(r) = Join(a, "")
  62.     Next
  63.     For i = 1 To UBound(Arr)
  64.         For x = 1 To 3
  65.             a(x) = Mid(Arr(i, 1), x, 1)
  66.         Next
  67.         r = r + 1
  68.         ReDim Preserve Arr1(1 To r)
  69.         a(2) = Val(a(2)) + j
  70.         a(2) = Right(a(2), 1)
  71.         a(3) = Val(a(3)) + j
  72.         a(3) = Right(a(3), 1)
  73.         Arr1(r) = Join(a, "")
  74.     Next
  75.     Cells(1, j + 4).Resize(r, 1) = Application.Transpose(Arr1)
  76. Next
  77. End Sub
复制代码

百十个1012.rar

15.29 KB, 下载次数: 1
回复

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-5-19 23:50 , Processed in 0.254294 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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