设为首页收藏本站
简字体切换切换到宽版

ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步，快速开始

快捷登录

搜索
ExcelHome技术论坛»论坛 › Excel 技术交流与问答 › Excel VBA程序开发 › 新手，自己写的VBA代码，运行效率太慢了。
EH技术汇-专业的职场技能充电站 妙哉！函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
12下一页
返回列表 发新帖
查看: 4017|回复: 15

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

[复制链接]
nkmamatjan123

TA的精华主题

TA的得分主题
发表于 2018-3-12 19:18 | 显示全部楼层 |阅读模式
[广告] ★ ChatOffice，能听会写的AI办公，包含百种Excel、Word、PPT工具，兼容WPS，百倍效率！★
新手，自己写的VBA代码，运行效率太慢了。能不能缩减代码？或者用数组提高效率。
  1. Sub head01()

  3. Dim b, c, d

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

  19. Sub transmdd01()


  22. For i = 1 To [a65536].End(3).Row
  23.   For j = 2 To 25
  24.   
  25. Select Case Mid(Cells(i, 1), j, 1)


  28. Case Cells(2, 6)

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

  32. Case Cells(3, 6)
  33.    
  34.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(3, 8))
  35.    
  36. Case Cells(4, 6)
  37.    
  38.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(4, 8))
  39.    
  40. Case Cells(5, 6)
  41.    
  42.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(5, 8))
  43.    
  44. Case Cells(6, 6)
  45.    
  46.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(6, 8))
  47.    
  48. Case Cells(7, 6)
  49.    
  50.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(7, 8))
  51.    
  52. Case Cells(8, 6)
  53.    
  54.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(8, 8))
  55.    
  56. Case Cells(9, 6)
  57.    
  58.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(9, 8))
  59.    
  60. Case Cells(10, 6)
  61.    
  62.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(10, 8))
  63.    
  64. Case Cells(11, 6)
  65.    
  66.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(11, 8))

  68. Case Cells(12, 6)
  69.    
  70.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(12, 8))

  72. Case Cells(13, 6)
  73.    
  74.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(13, 8))
  75.    
  76. Case Cells(14, 6)
  77.    
  78.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(14, 8))
  79.    
  80. Case Cells(15, 6)
  81.    
  82.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(15, 8))
  83.   
  84. Case Cells(16, 6)
  85.    
  86.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(16, 8))
  87.    
  88. Case Cells(17, 6)
  89.    
  90.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(17, 8))
  91.    
  92. Case Cells(18, 6)
  93.    
  94.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(18, 8))

  96. Case Cells(19, 6)
  97.    
  98.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(19, 8))
  99.    
  100. Case Cells(20, 6)
  101.    
  102.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(20, 8))
  103.    
  104. Case Cells(21, 6)
  105.    
  106.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(21, 8))
  107.    
  108. Case Cells(22, 6)
  109.    
  110.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(22, 8))
  111.    
  112. Case Cells(23, 6)
  113.    
  114.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(23, 8))
  115.    
  116. Case Cells(24, 6)
  117.    
  118.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(24, 8))
  119.    
  120. Case Cells(25, 6)
  121.    
  122.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(25, 8))
  123.    
  124. Case Cells(26, 6)
  125.    
  126.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(26, 8))
  127.    
  128. Case Cells(27, 6)
  129.    
  130.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(27, 8))
  131.    
  132. Case Cells(28, 6)
  133.    
  134.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(28, 8))
  135.    
  136. Case Cells(29, 6)
  137.    
  138.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(29, 8))
  139.    
  140. Case Cells(30, 6)
  141.    
  142.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(30, 8))
  143.    
  144. Case Cells(31, 6)
  145.    
  146.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(31, 8))

  148. Case Cells(32, 6)
  149.    
  150.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(32, 8))
  151.    
  152. Case Cells(33, 6)
  153.    
  154.    Cells(i, 2).Value = Replace(Cells(i, 2).Value, Mid(Cells(i, 2), j, 1), Cells(33, 8))
  155.    
  156.    

  158. End Select


  161. Next j
  162. Next i

  164. End Sub


  167. Sub spellcheck01()

  169. For i = 1 To 5200

  171.   For j = 1 To 4200

  173. If Mid(Sheet1.Cells(i, 2), 1, 2) = Sheet1.Cells(j, 12) Then
  174.   
  175.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 1, 2), Cells(j, 13))


  178. Else


  181. End If


  184. If Mid(Sheet1.Cells(i, 2), 2, 2) = Sheet1.Cells(j, 12) Then
  185.   
  186.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 2, 2), Cells(j, 13))


  189. Else

  191. End If


  194. If Mid(Sheet1.Cells(i, 2), 3, 2) = Sheet1.Cells(j, 12) Then
  195.   
  196.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 3, 2), Cells(j, 13))


  199. Else

  201. End If


  204. If Mid(Sheet1.Cells(i, 2), 4, 2) = Sheet1.Cells(j, 12) Then
  205.   
  206.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 4, 2), Cells(j, 13))


  209. Else

  211. End If

  213. If Mid(Sheet1.Cells(i, 2), 5, 2) = Sheet1.Cells(j, 12) Then
  214.   
  215.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 5, 2), Cells(j, 13))


  218. Else

  220. End If

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


  227. Else

  229. End If

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


  236. Else

  238. End If

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


  245. Else

  247. End If


  250. If Mid(Sheet1.Cells(i, 2), 9, 2) = Sheet1.Cells(j, 12) Then
  251.   
  252.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 9, 2), Cells(j, 13))


  255. Else

  257. End If

  259. If Mid(Sheet1.Cells(i, 2), 10, 2) = Sheet1.Cells(j, 12) Then
  260.   
  261.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 10, 2), Cells(j, 13))


  264. Else

  266. End If

  268. If Mid(Sheet1.Cells(i, 2), 11, 2) = Sheet1.Cells(j, 12) Then
  269.   
  270.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 11, 2), Cells(j, 13))


  273. Else

  275. End If

  277. If Mid(Sheet1.Cells(i, 2), 12, 2) = Sheet1.Cells(j, 12) Then
  278.   
  279.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 12, 2), Cells(j, 13))


  282. Else

  284. End If

  286. If Mid(Sheet1.Cells(i, 2), 13, 2) = Sheet1.Cells(j, 12) Then
  287.   
  288.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 13, 2), Cells(j, 13))


  291. Else

  293. End If


  296. If Mid(Sheet1.Cells(i, 2), 14, 2) = Sheet1.Cells(j, 12) Then
  297.   
  298.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 14, 2), Cells(j, 13))


  301. Else

  303. End If

  305. If Mid(Sheet1.Cells(i, 2), 15, 2) = Sheet1.Cells(j, 12) Then
  306.   
  307.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 15, 2), Cells(j, 13))


  310. Else

  312. End If

  314. If Mid(Sheet1.Cells(i, 2), 16, 2) = Sheet1.Cells(j, 12) Then
  315.   
  316.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 16, 2), Cells(j, 13))


  319. Else

  321. End If

  323. If Mid(Sheet1.Cells(i, 2), 17, 2) = Sheet1.Cells(j, 12) Then
  324.   
  325.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 17, 2), Cells(j, 13))


  328. Else

  330. End If

  332. If Mid(Sheet1.Cells(i, 2), 18, 2) = Sheet1.Cells(j, 12) Then
  333.   
  334.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 18, 2), Cells(j, 13))


  337. Else

  339. End If


  342. If Mid(Sheet1.Cells(i, 2), 19, 2) = Sheet1.Cells(j, 12) Then
  343.   
  344.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 19, 2), Cells(j, 13))


  347. Else

  349. End If

  351. If Mid(Sheet1.Cells(i, 2), 20, 2) = Sheet1.Cells(j, 12) Then
  352.   
  353.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Mid(Sheet1.Cells(i, 2), 20, 2), Cells(j, 13))


  356. Else

  358. End If



  362.                    Next j

  364.             Next i




  369. End Sub


  372. Sub spellcheck02()

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

  376.   For j = 1 To [o65536].End(3).Row
  377.    
  378. If Right(Sheet1.Cells(i, 2), 2) = Sheet1.Cells(j, 15) Then
  379.   
  380.   Sheet1.Cells(i, 2).Value = Replace(Sheet1.Cells(i, 2).Value, Right(Sheet1.Cells(i, 2), 2), Cells(j, 16))


  383. Else

  385. End If

  387. Next j

  389. Next i




  394. End Sub







复制代码
代码, 新手, 自己, 写的, 运行
回复

举报

onlycxb

TA的精华主题

TA的得分主题
发表于 2018-3-12 19:19 | 显示全部楼层
[广告] ★Excel Home云课堂 - 专业的职场技能充电站★         ★Excel三大利器★        ★ 笨办法学VBA全系列★
先将数据放入数组，在数组中处理后再写入单元格
回复

举报

nkmamatjan123

TA的精华主题

TA的得分主题
 楼主| 发表于 2018-3-12 19:27 | 显示全部楼层
[广告] ★用Excel做企业管理系统，Excel服务器学习和下载★
onlycxb 发表于 2018-3-12 19:19
先将数据放入数组，在数组中处理后再写入单元格

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

举报

2489586288

TA的精华主题

TA的得分主题
发表于 2018-3-12 19:33 来自手机 | 显示全部楼层
[广告] ★ExcelHome默写助手 - 不用妈妈陪的默写神器 · Word/WPS插件 · 自定义默写单 · 自定义描红字帖★
毅力可嘉。。。这么长
回复

举报

nkmamatjan123

TA的精华主题

TA的得分主题
 楼主| 发表于 2018-3-12 19:36 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册★
2489586288 发表于 2018-3-12 19:33
毅力可嘉。。。这么长

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

举报

sxfxtf

TA的精华主题

TA的得分主题
发表于 2018-3-12 20:40 | 显示全部楼层
[广告] ★用Excel做企业管理系统，Excel服务器学习和下载★
nkmamatjan123 发表于 2018-3-12 19:36
都是一些简单的判断。没学好数组，代码变长了。

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

举报

jiminyanyan

TA的精华主题

TA的得分主题
发表于 2018-3-12 20:46 | 显示全部楼层
[广告] ★用Excel做企业管理系统，Excel服务器学习和下载★
用数组吧，太长了，没兴趣看。。。。
回复

举报

skyzxh

TA的精华主题

TA的得分主题
发表于 2018-3-12 21:36 | 显示全部楼层
[广告] ★用Excel做企业管理系统，Excel服务器学习和下载★
还不如上传文件，说明要求，这么长谁有耐心看完？
回复

举报

nkmamatjan123

TA的精华主题

TA的得分主题
 楼主| 发表于 2018-3-12 23:27 来自手机 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助★
skyzxh 发表于 2018-3-12 21:36
还不如上传文件，说明要求，这么长谁有耐心看完？

好，上传附近，希望有人能帮忙。
回复

举报

nkmamatjan123

TA的精华主题

TA的得分主题
 楼主| 发表于 2018-3-12 23:36 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册★
附件在这里。

原始坐标01.zip

18.6 KB, 下载次数: 11
回复

举报

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

本版积分规则

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

GMT+8, 2024-5-2 06:02 , Processed in 0.042938 second(s), 10 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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