如何解决复制并移动数据的代码确实很慢
在过去的几周中，工作使我建立了新的报价单。我的代码从上次使用的工作表中提取数据，然后根据您在该工作表中选择的内容生成一个报价（"Data Entry"
我将其交给了老板，但请注意，我用来将所选数据复制并移动到正在生成的报价中的过程很慢。我想出的最好的方法是给出一致的结果并且几乎没有错误。但是，从单击到生成报价，对于喜欢老板的人来说花费的时间太长。
有没有一种方法可以改善我的代码，从而使过程更快？我只是编码方面的新手（即使我在这里得到了帮助，也为我最终的产品感到自豪，所以向所有帮助过的人大喊大叫）。
这是字符串：
Dim i As Long
Dim cell As Range
For i = o To lastdtyperow
'copies types
Set cell = dataentry.Range("B9").Offset(i,0)
If Not IsEmpty(cell) Then
quote1.Range("A13").Offset(i,0) = cell.Value
quote1.Range("A13").Offset(i,0).HorizontalAlignment = xlCenter
quote1.Range("A13").Offset(i,0).VerticalAlignment = xlCenter
quote1.Range("A13").Offset(i,0).WrapText = True
End If
'copies quantities
Set cell = dataentry.Range("C9").Offset(i,0)
If Not IsEmpty(cell) Then
quote1.Range("B13").Offset(i,0) = cell.Value
quote1.Range("B13").Offset(i,0).HorizontalAlignment = xlCenter
quote1.Range("B13").Offset(i,0).VerticalAlignment = xlCenter
quote1.Range("B13").Offset(i,0).NumberFormat = "#,##0"
End If
'copies mfr
Set cell = dataentry.Range("AB9").Offset(i,0)
If Not IsEmpty(cell) Then
quote1.Range("C13").Offset(i,0) = cell.Value
quote1.Range("C13").Offset(i,0).HorizontalAlignment = xlCenter
quote1.Range("C13").Offset(i,##0"
quote1.Range("C13").Offset(i,0).WrapText = True
quote1.Range("C13").Offset(i,0).VerticalAlignment = xlCenter
End If
'copies cat number
Set cell = dataentry.Range("AC9").Offset(i,0)
If Not IsEmpty(cell) Then
quote1.Range("D13").Offset(i,0) = cell.Value
quote1.Range("D13").Offset(i,0).HorizontalAlignment = xlCenter
quote1.Range("D13").Offset(i,0).VerticalAlignment = xlCenter
quote1.Range("D13").Offset(i,0).WrapText = True
End If
'copies notes
Set cell = dataentry.Range("AD9").Offset(i,0)
If Not IsEmpty(cell) Then
quote1.Range("E13").Offset(i,0) = cell.Value
quote1.Range("E13").Offset(i,0).HorizontalAlignment = xlCenter
quote1.Range("E13").Offset(i,0).WrapText = True
quote1.Range("E13").Offset(i,0).Font.Size = 11
quote1.Range("E13").Offset(i,0).Font.Name = "Calibri"
End If
'copies prices
Set cell = dataentry.Range("AJ9").Offset(i,0)
If Not IsEmpty(cell) Then
quote1.Range("F13").Offset(i,0) = cell.Value
quote1.Range("F13").Offset(i,0).HorizontalAlignment = xlRight
quote1.Range("F13").Offset(i,0).VerticalAlignment = xlCenter
quote1.Range("F13").Offset(i,0).NumberFormat = "$#,##0.00"
quote1.Range("F13").Offset(i,0).Font.Bold = False
End If
Next i
相关部分：
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'sets easy code for to last row,then move data up to next row that contains nothing
Dim lastdtyperow,lastdqtyrow,lastqtyperow
Dim dataentry As Worksheet,quote1 As Worksheet,data As Worksheet
Dim typ As Range
之所以如此之慢，是因为它会逐个单元地移动，检查数据，是否找到数据，复制并粘贴然后格式化。我确定执行基于行而不是单元格的方法会更快，并且等到最后应用格式设置。
如果需要，我可以发布全部代码以显示表单的生成方式。如果这个问题（我想这可能几乎是在寻求帮助）很雄心勃勃，那么它就是它了。
解决方法
请尽量减少Excel-VBA的交互，因为每次将控件传递给Excel时，Excel都会执行数百（甚至数千个）操作。其中有些（例如.ScreenUpdating）可以控制，而有些则不能。
-
主要的改进可以是复制和格式化块，而不是像单个单元格那样
With quote1 ' copy formulas and formats Range(dataentry.Cells(9,"B"),Cells(9 + lastdtyperow,"C")).Copy _ Destination:=Range(.Cells(13,"A"),.Cells(13 + lastdtyperow,"B")) Range(dataentry.Cells(9,"AB"),"AD")).Copy _ Destination:=Range(.Cells(13,"C"),"E")) ' OR copy values only Range(dataentry.Cells(9,"C")).Copy Range(.Cells(13,"B")).Pastespecial xlpastevalues ' copy formats only (apply format of source on destination) Range(dataentry.Cells(9,"B")).Pastespecial xlpasteformats
注意：您需要分别发行2个.Pastespecial，但不需要重复发行.Copy
' format data column by column
...
Range(.Cells(13,"A")).WrapText = True
...
End With
借此，您可以将Excel-VBA交互从〜30 * lastdtyperow减少到〜30
-
使用
With。它可以提高性能，并节省大量打字工作。 -
如果要隐藏在块中复制空单元格时可能显示的空单元格的0值，此单元格格式将用空字符串替换它们：
.NumberFormat = "#,##0;-#,##0;""""
请注意尾随引号，您将需要很多：）
版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。