头大了，效率太慢，VBA的问题，麻烦大家

junjinling

判断产线滞留品的问题。
《外观后》是最后一道工序
从最后一道工序判定，例如第六行，最后一道工序是 焊接后，则判定 焊接后与 打线后 这两者的日期，若是焊接后的日期大于 打线后的日期+2
则判定为滞留品
再看第七行，最后一道工序是 打端子工序，而前一道工序是水槽，水槽日期是空白，则用 打端子后的日期与 封入检查后日期对比，若是打端子日期
大于 封入检查后日期+3,则判定滞留品。
以上滞留品的这3个字，再V列写入。


我的代码是
Sub 按钮825_Click()
Application.ScreenUpdating = False

Dim j As Integer
Dim i As Integer
Dim n As Integer
n = WorksheetFunction.CountA(Range("B6:B3000"))
Range("g6:M1000").Interior.ColorIndex = 0
Range("V6:v1000").ClearContents
For j = 1 To n
   For i = 13 To 8 Step -1
         If Cells(j + 5, i) <> "" Then
              If Cells(j + 5, i - 1) <> "" Then
                  If Cells(j + 5, i) > Cells(j + 5, i - 1) + Cells(4, i) Then
                     Cells(j + 5, 22) = "停滞品"
                     Exit For
                  Else
                  Exit For
                  End If
              Else
                  If Cells(j + 5, i) > Cells(j + 5, i - 2) + Cells(4, i) Then
                     Cells(j + 5, 22) = "停滞品"
                     Exit For
                  Else
                  Exit For
                  End If
              End If
         End If
   Next
Next
Application.ScreenUpdating = True
ActiveWorkbook.Save
MsgBox ("更新并保存完毕")
End Sub



当遇到 500行的时候就会很卡很卡。
麻烦大家了。

zpy2

可能是循环太多比较慢，可能要算法或业务修改下才能提高效率

junjinling

朱荣兴 发表于 2019-3-14 08:20
不急要操作单元格，把单元格区域赋值给数组，在数组中判断，然后在写入单元格区域，速度就会快很多了，基本 ...

您好，可以帮我弄下吗。。。数组我不懂

山菊花

首楼的代码写得不差，效率不理想的原因应该是数据太多，保存时间长。
改用数组如下，请测试。
  　

1. Sub 按钮825_Click()
   
2.     Application.ScreenUpdating = False
   
3.    
   
4.     Dim j As Integer
   
5.     Dim i As Integer, i2%
   
6.     Dim n As Integer
   
7.     Dim Arr(), Brr()
   
8.     n = Range("g65536").End(xlUp).Row 'G列最后一个数据所在行号
   
9.     Arr = Range("g4:m" & n).Value '将数据保存到数组Arr
   
10.     ReDim Brr(3 To n, 1 To 1)
    
11.    
    
12.     Range("g6:M1000").Interior.ColorIndex = 0
    
13.     Range("V6:v1000").ClearContents
    
14.    
    
15.     For j = 3 To n - 3
    
16.         For i = 7 To 2 Step -1
    
17.             If Arr(j, i) > 0 Then
    
18.                 i2 = IIf(Arr(j, i - 1) > 0, i - 1, i - 2)
    
19.                 If Arr(j, i) > Arr(j, i2) + Arr(1, i) Then Brr(j, 1) = "停滞品"
    
20.                 Exit For
    
21.             End If
    
22.         Next
    
23.     Next
    
24.     Range("v6:v" & n).Value = Brr
    
25.     Application.ScreenUpdating = True
    
26.     ActiveWorkbook.Save
    
27.    
    
28.     MsgBox ("更新并保存完毕")
    
29. 
    
30. End Sub

复制代码

tyc00133

学习了，牛人真多

microyip

山版的数组解决才是正道，直接对单元格进行频繁操作会比较慢，还有，需要屏蔽屏幕刷新也会对提高时效性有帮助。

junjinling

山菊花 发表于 2019-3-14 10:46
首楼的代码写得不差，效率不理想的原因应该是数据太多，保存时间长。
改用数组如下，请测试。
  　

谢谢，我测试下

junjinling

山菊花 发表于 2019-3-14 10:46
首楼的代码写得不差，效率不理想的原因应该是数据太多，保存时间长。
改用数组如下，请测试。
  　

您好，很是感谢，速度快多了。谢谢您。

junjinling

嗯，学习了。