ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

   
高效办公必会的Office实战技巧 永久免费,网表让Excel秒变数据库 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel函数公式学习大典 一份“吓死人”的Excel世界杯模板 免费下载Excel行业应用视频
300集Office 2010微视频教程 Tableau-数据可视化工具 突破Excel限制,用活字格提高效率 13门Excel免费公开课任你学
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 免费的Excel考勤计算系统
查看: 527|回复: 15

[求助] 新手,自己写的VBA代码,运行效率太慢了。

[复制链接]

TA的精华主题

TA的得分主题

发表于 2018-3-12 19:18 | 显示全部楼层 |阅读模式
新手,自己写的VBA代码,运行效率太慢了。能不能缩减代码?或者用数组提高效率。
  1. Sub head01()

  2. Dim b, c, d

  3. For i = 1 To [a65536].End(3).Row
  4.     For j = 2 To 33
  5.     If Mid(Cells(i, 1), 1, 1) = Cells(j, 6) Then
  6.    
  7.    Cells(i, 2) = Cells(j, 7) & Mid(Cells(i, 1), 2, 100)
  8.    Else
  9.    
  10.    End If
  11.    
  12.    Next j
  13. Next i
  14.    
  15. End Sub

  16. Sub transmdd01()


  17. For i = 1 To [a65536].End(3).Row
  18.   For j = 2 To 25
  19.   
  20. Select Case Mid(Cells(i, 1), j, 1)


  21. Case Cells(2, 6)

  22.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(2, 8))

  23. Case Cells(3, 6)
  24.    
  25.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(3, 8))
  26.    
  27. Case Cells(4, 6)
  28.    
  29.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(4, 8))
  30.    
  31. Case Cells(5, 6)
  32.    
  33.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(5, 8))
  34.    
  35. Case Cells(6, 6)
  36.    
  37.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(6, 8))
  38.    
  39. Case Cells(7, 6)
  40.    
  41.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(7, 8))
  42.    
  43. Case Cells(8, 6)
  44.    
  45.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(8, 8))
  46.    
  47. Case Cells(9, 6)
  48.    
  49.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(9, 8))
  50.    
  51. Case Cells(10, 6)
  52.    
  53.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(10, 8))
  54.    
  55. Case Cells(11, 6)
  56.    
  57.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(11, 8))

  58. Case Cells(12, 6)
  59.    
  60.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(12, 8))

  61. Case Cells(13, 6)
  62.    
  63.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(13, 8))
  64.    
  65. Case Cells(14, 6)
  66.    
  67.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(14, 8))
  68.    
  69. Case Cells(15, 6)
  70.    
  71.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(15, 8))
  72.   
  73. Case Cells(16, 6)
  74.    
  75.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(16, 8))
  76.    
  77. Case Cells(17, 6)
  78.    
  79.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(17, 8))
  80.    
  81. Case Cells(18, 6)
  82.    
  83.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(18, 8))

  84. Case Cells(19, 6)
  85.    
  86.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(19, 8))
  87.    
  88. Case Cells(20, 6)
  89.    
  90.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(20, 8))
  91.    
  92. Case Cells(21, 6)
  93.    
  94.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(21, 8))
  95.    
  96. Case Cells(22, 6)
  97.    
  98.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(22, 8))
  99.    
  100. Case Cells(23, 6)
  101.    
  102.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(23, 8))
  103.    
  104. Case Cells(24, 6)
  105.    
  106.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(24, 8))
  107.    
  108. Case Cells(25, 6)
  109.    
  110.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(25, 8))
  111.    
  112. Case Cells(26, 6)
  113.    
  114.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(26, 8))
  115.    
  116. Case Cells(27, 6)
  117.    
  118.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(27, 8))
  119.    
  120. Case Cells(28, 6)
  121.    
  122.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(28, 8))
  123.    
  124. Case Cells(29, 6)
  125.    
  126.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(29, 8))
  127.    
  128. Case Cells(30, 6)
  129.    
  130.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(30, 8))
  131.    
  132. Case Cells(31, 6)
  133.    
  134.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(31, 8))

  135. Case Cells(32, 6)
  136.    
  137.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(32, 8))
  138.    
  139. Case Cells(33, 6)
  140.    
  141.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(33, 8))
  142.    
  143.    

  144. End Select


  145. Next j
  146. Next i

  147. End Sub


  148. Sub spellcheck01()

  149. For i = 1 To 5200

  150.   For j = 1 To 4200

  151. If Mid(Sheet1.Cells(i, 2), 1, 2) = Sheet1.Cells(j, 12) Then
  152.   
  153.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 1, 2), Cells(j, 13))


  154. Else


  155. End If


  156. If Mid(Sheet1.Cells(i, 2), 2, 2) = Sheet1.Cells(j, 12) Then
  157.   
  158.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 2, 2), Cells(j, 13))


  159. Else

  160. End If


  161. If Mid(Sheet1.Cells(i, 2), 3, 2) = Sheet1.Cells(j, 12) Then
  162.   
  163.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 3, 2), Cells(j, 13))


  164. Else

  165. End If


  166. If Mid(Sheet1.Cells(i, 2), 4, 2) = Sheet1.Cells(j, 12) Then
  167.   
  168.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 4, 2), Cells(j, 13))


  169. Else

  170. End If

  171. If Mid(Sheet1.Cells(i, 2), 5, 2) = Sheet1.Cells(j, 12) Then
  172.   
  173.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 5, 2), Cells(j, 13))


  174. Else

  175. End If

  176. If Mid(Sheet1.Cells(i, 2), 6, 2) = Sheet1.Cells(j, 12) Then
  177.   
  178.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 6, 2), Cells(j, 13))


  179. Else

  180. End If

  181. If Mid(Sheet1.Cells(i, 2), 7, 2) = Sheet1.Cells(j, 12) Then
  182.   
  183.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 7, 2), Cells(j, 13))


  184. Else

  185. End If

  186. If Mid(Sheet1.Cells(i, 2), 8, 2) = Sheet1.Cells(j, 12) Then
  187.   
  188.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 8, 2), Cells(j, 13))


  189. Else

  190. End If


  191. If Mid(Sheet1.Cells(i, 2), 9, 2) = Sheet1.Cells(j, 12) Then
  192.   
  193.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 9, 2), Cells(j, 13))


  194. Else

  195. End If

  196. If Mid(Sheet1.Cells(i, 2), 10, 2) = Sheet1.Cells(j, 12) Then
  197.   
  198.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 10, 2), Cells(j, 13))


  199. Else

  200. End If

  201. If Mid(Sheet1.Cells(i, 2), 11, 2) = Sheet1.Cells(j, 12) Then
  202.   
  203.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 11, 2), Cells(j, 13))


  204. Else

  205. End If

  206. If Mid(Sheet1.Cells(i, 2), 12, 2) = Sheet1.Cells(j, 12) Then
  207.   
  208.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 12, 2), Cells(j, 13))


  209. Else

  210. End If

  211. If Mid(Sheet1.Cells(i, 2), 13, 2) = Sheet1.Cells(j, 12) Then
  212.   
  213.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 13, 2), Cells(j, 13))


  214. Else

  215. End If


  216. If Mid(Sheet1.Cells(i, 2), 14, 2) = Sheet1.Cells(j, 12) Then
  217.   
  218.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 14, 2), Cells(j, 13))


  219. Else

  220. End If

  221. If Mid(Sheet1.Cells(i, 2), 15, 2) = Sheet1.Cells(j, 12) Then
  222.   
  223.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 15, 2), Cells(j, 13))


  224. Else

  225. End If

  226. If Mid(Sheet1.Cells(i, 2), 16, 2) = Sheet1.Cells(j, 12) Then
  227.   
  228.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 16, 2), Cells(j, 13))


  229. Else

  230. End If

  231. If Mid(Sheet1.Cells(i, 2), 17, 2) = Sheet1.Cells(j, 12) Then
  232.   
  233.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 17, 2), Cells(j, 13))


  234. Else

  235. End If

  236. If Mid(Sheet1.Cells(i, 2), 18, 2) = Sheet1.Cells(j, 12) Then
  237.   
  238.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 18, 2), Cells(j, 13))


  239. Else

  240. End If


  241. If Mid(Sheet1.Cells(i, 2), 19, 2) = Sheet1.Cells(j, 12) Then
  242.   
  243.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 19, 2), Cells(j, 13))


  244. Else

  245. End If

  246. If Mid(Sheet1.Cells(i, 2), 20, 2) = Sheet1.Cells(j, 12) Then
  247.   
  248.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 20, 2), Cells(j, 13))


  249. Else

  250. End If



  251.                    Next j

  252.             Next i




  253. End Sub


  254. Sub spellcheck02()

  255. For i = 1 To [a65536].End(3).Row

  256.   For j = 1 To [o65536].End(3).Row
  257.    
  258. If Right(Sheet1.Cells(i, 2), 2) = Sheet1.Cells(j, 15) Then
  259.   
  260.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Right(Sheet1.Cells(i, 2), 2), Cells(j, 16))


  261. Else

  262. End If

  263. Next j

  264. Next i




  265. End Sub







复制代码

TA的精华主题

TA的得分主题

发表于 2018-3-12 19:19 | 显示全部楼层
先将数据放入数组,在数组中处理后再写入单元格

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-3-12 19:27 | 显示全部楼层
onlycxb 发表于 2018-3-12 19:19
先将数据放入数组,在数组中处理后再写入单元格

不会用数组。这些都是看论坛学的。就是没学会数组。帮忙用数组简化一下。

TA的精华主题

TA的得分主题

发表于 2018-3-12 19:33 来自手机 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-3-12 19:36 | 显示全部楼层
2489586288 发表于 2018-3-12 19:33
毅力可嘉。。。这么长

都是一些简单的判断。没学好数组,代码变长了。

TA的精华主题

TA的得分主题

发表于 2018-3-12 20:40 | 显示全部楼层
nkmamatjan123 发表于 2018-3-12 19:36
都是一些简单的判断。没学好数组,代码变长了。

你还是直接发附件告诉我们要怎么处理,再帮你写个数组的比较好.

TA的精华主题

TA的得分主题

发表于 2018-3-12 20:46 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2018-3-12 21:36 | 显示全部楼层
还不如上传文件,说明要求,这么长谁有耐心看完?

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-3-12 23:27 来自手机 | 显示全部楼层
skyzxh 发表于 2018-3-12 21:36
还不如上传文件,说明要求,这么长谁有耐心看完?

好,上传附近,希望有人能帮忙。

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-3-12 23:36 | 显示全部楼层
附件在这里。

原始坐标01.zip

18.6 KB, 下载次数: 9

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

本版积分规则

关注官方微信,高效办公专列,每天发车

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2018-6-24 02:03 , Processed in 3.601477 second(s), 12 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 2001-2017 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

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