ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 987|回复: 2

[讨论] vba新手编了个程序,但是感觉太啰嗦了,请各位大神帮我看看有哪些地方可以优化?

[复制链接]

TA的精华主题

TA的得分主题

发表于 2020-1-14 08:40 | 显示全部楼层 |阅读模式
窗体内的代码如下:  详细代码见附件货物清单内
  1. Private Sub CommandButton1_Click()
  2.    
  3.     Application.DisplayAlerts = False
  4.     Application.ScreenUpdating = False
  5.    
  6.     'Me.OptionButton1.Value = True
  7.     Dim syb As String
  8.     Dim m As Integer
  9.     Dim sh As Workbook
  10.     Dim hwmc As String
  11.     Dim i As Integer
  12.     Dim x As Integer
  13.    
  14.    
  15.     Unload UserForm2     '关闭窗体
  16.     '-------------确定事业部---------------
  17.     If Me.OptionButton1.Value = True Then
  18.         syb = "开关"
  19.     ElseIf Me.OptionButton2.Value = True Then
  20.         syb = "自动化"
  21.     ElseIf Me.OptionButton3.Value = True Then
  22.         syb = "成套"
  23.         Else: syb = "变压器"
  24.     End If
  25.    
  26.    
  27.    
  28.     '-------------取标段名称-----------------
  29.     Range("a1").Select
  30.     Selection.UnMerge
  31.     'Range("A1").Select
  32.     hwmc = Range("a1").Value
  33.    
  34.     '-------------取行数,并复制需要的列----------------
  35.     m = Range("b65536").End(xlUp).Row
  36.     Range("a3:a" & m & ",g3:g" & m & ",j3:j" & m).Select
  37.    
  38.     Selection.Copy
  39.     '-------------打开汇总表,黏贴复制的值,使F列不自动换行---------
  40.     Set sh = Application.Workbooks.Open("C:\Users\Administrator\Desktop\汇总表.xls")
  41.     n = Range("b65536").End(xlUp).Row
  42.     Range("E" & n + 1).Select
  43.     ActiveSheet.Paste
  44.     Range("F:F").Select
  45.     Selection.WrapText = False
  46.    
  47.     '--------------------------转换为数字--------------------
  48.    
  49.     Range("g" & n + 1, "g" & n + m - 2).Select
  50.     Dim rng As Range
  51.     '遍历每个选择区域
  52.     For Each rng In Selection
  53.         '遍历当前选中区的所有单元格
  54.         For Each cell In rng.Cells
  55.             cell.Value = cell.Value
  56.         Next
  57.     Next
  58.    
  59.    
  60.    
  61.     '--------------------填充标段名和事业部名称----------------------
  62.     Range("b" & n + 1 & ":b" & n + m - 2).Value = syb
  63.     Range("d" & n + 1 & ":d" & n + m - 2).Value = hwmc
  64.    
  65.    
  66.     For i = n + 1 To n + m - 2
  67.         Range("h" & i) = Range("d" & i) & Range("e" & i)
  68.         Range("a" & i) = i - 1
  69.         
  70.         
  71.     Next
  72.    
  73.    
  74.     '--------------------合并单元格-------------------------------
  75.     Call 合并单元格
  76.     'Range("h" & n + 1 & ":h" & n + m - 2).ClearContents
  77.    
  78.     '------------------求和-----------------------------
  79.     For x = n + 1 To n + m - 2
  80.         
  81.         Cells(x, 8) = Application.WorksheetFunction.SumIfs(Range("G:G"), Range("D:D"), Cells(x, 4), Range("E:E"), Cells(x, 5))
  82.         
  83.     Next
  84.    
  85.     '-----------------设置格式--------------------------
  86.    
  87.    
  88.     Call geshi
  89.    
  90.    
  91.     Range("a" & n + 1, "i" & n + m - 2).Select
  92.    
  93.    
  94.    
  95.     With Selection.Font
  96.         .Name = "宋体"
  97.         .Size = 10
  98.         .Strikethrough = False
  99.         .Superscript = False
  100.         .Subscript = False
  101.         .OutlineFont = False
  102.         .Shadow = False
  103.         .Underline = xlUnderlineStyleNone
  104.         .ColorIndex = xlAutomatic
  105.         .TintAndShade = 0
  106.         .ThemeFont = xlThemeFontNone
  107.     End With
  108.     With Selection.Font
  109.         .Name = "宋体"
  110.         .Size = 10
  111.         .Strikethrough = False
  112.         .Superscript = False
  113.         .Subscript = False
  114.         .OutlineFont = False
  115.         .Shadow = False
  116.         .Underline = xlUnderlineStyleNone
  117.         .ColorIndex = xlAutomatic
  118.         .TintAndShade = 0
  119.         .ThemeFont = xlThemeFontNone
  120.     End With
  121.     Selection.Borders(xlDiagonalDown).LineStyle = xlNone
  122.     Selection.Borders(xlDiagonalUp).LineStyle = xlNone
  123.     With Selection.Borders(xlEdgeLeft)
  124.         .LineStyle = xlContinuous
  125.         .ColorIndex = 0
  126.         .TintAndShade = 0
  127.         .Weight = xlThin
  128.     End With
  129.     With Selection.Borders(xlEdgeTop)
  130.         .LineStyle = xlContinuous
  131.         .ColorIndex = 0
  132.         .TintAndShade = 0
  133.         .Weight = xlThin
  134.     End With
  135.     With Selection.Borders(xlEdgeBottom)
  136.         .LineStyle = xlContinuous
  137.         .ColorIndex = 0
  138.         .TintAndShade = 0
  139.         .Weight = xlThin
  140.     End With
  141.     With Selection.Borders(xlEdgeRight)
  142.         .LineStyle = xlContinuous
  143.         .ColorIndex = 0
  144.         .TintAndShade = 0
  145.         .Weight = xlThin
  146.     End With
  147.     With Selection.Borders(xlInsideVertical)
  148.         .LineStyle = xlContinuous
  149.         .ColorIndex = 0
  150.         .TintAndShade = 0
  151.         .Weight = xlThin
  152.     End With
  153.     With Selection.Borders(xlInsideHorizontal)
  154.         .LineStyle = xlContinuous
  155.         .ColorIndex = 0
  156.         .TintAndShade = 0
  157.         .Weight = xlThin
  158.     End With
  159.    
  160.     ActiveWorkbook.Save
  161.     ActiveWorkbook.Close
  162.    
  163.     Application.DisplayAlerts = True
  164.     Application.ScreenUpdating = True
  165.    
  166. End Sub
复制代码


工程-1-投标项目汇总.zip

160.85 KB, 下载次数: 2

TA的精华主题

TA的得分主题

发表于 2020-1-14 08:45 | 显示全部楼层
一看就是录制宏得来的代码,可以简化很多,

TA的精华主题

TA的得分主题

发表于 2020-1-14 10:01 | 显示全部楼层
可优化的地方很多。

直接单元格.select的操作、复制、粘贴,转化为数字,赋值。
都可以去掉。改为数组处理。

后面geshi的那段,有重复,应该是直接宏录制出来的,可自行删减不必要的部分。

但是我也只能这么粗略的说说。
因为你给的文件没办法执行...窗体没了
只能大概猜一下部分代码可能是什么意思。
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-3-29 14:37 , Processed in 0.043527 second(s), 10 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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