Question

以下vba代码如何优化或简化可以提高运行速度很慢的问题

Private Sub CommandButton3_Click()
hang7 = 6
hang6 = 6
hang51 = 6
hang5 = 6
dangri = TextBox1.Text
If Trim(TextBox1.Text) = "" Then
MsgBox "不能为空"
Exit Sub
ElseIf IsNumeric(Trim(dangri)) = False Then
MsgBox "请输入数字"
Exit Sub
End If
MsgBox "程序开始运行，您千万务必不要进行表格的任何操作，运算结束，程序自有提示！！点击确定将开始匹配"
Worksheets("辅助").Range("A6:CV15000").ClearContents
For i = 26 To 6833
hang = TextBox1.Text
Y = 0
If Worksheets("357跨").Cells(TextBox1.Text, i).Interior.ColorIndex = 3 Then
Do While Worksheets("357跨").Cells(hang, i).Interior.ColorIndex = 3
Y = Y + 1
hang = TextBox1.Text - Y
Loop
If Y = 7 Then
Worksheets("辅助").Cells(hang7, 1) = Worksheets("357跨").Cells(1, i)
Worksheets("辅助").Cells(hang7, 2) = Worksheets("357跨").Cells(2, i)
Worksheets("辅助").Cells(hang7, 3) = Worksheets("357跨").Cells(3, i)
Worksheets("辅助").Cells(hang7, 4) = Worksheets("357跨").Cells(4, i)
Worksheets("辅助").Cells(hang7, 5) = Worksheets("357跨").Cells(5, i)
hang7 = hang7 + 1
End If
If Y = 6 Then
Worksheets("辅助").Cells(hang6, 6) = Worksheets("357跨").Cells(1, i)
Worksheets("辅助").Cells(hang6, 7) = Worksheets("357跨").Cells(2, i)
Worksheets("辅助").Cells(hang6, 8) = Worksheets("357跨").Cells(3, i)
Worksheets("辅助").Cells(hang6, 9) = Worksheets("357跨").Cells(4, i)
Worksheets("辅助").Cells(hang6, 10) = Worksheets("357跨").Cells(5, i)
hang6 = hang6 + 1
End If
If Y = 5 And Worksheets("357跨").Cells(hang - 1, i).Interior.ColorIndex = 3 Then
Worksheets("辅助").Cells(hang51, 11) = Worksheets("357跨").Cells(1, i)
Worksheets("辅助").Cells(hang51, 12) = Worksheets("357跨").Cells(2, i)
Worksheets("辅助").Cells(hang51, 13) = Worksheets("357跨").Cells(3, i)
Worksheets("辅助").Cells(hang51, 14) = Worksheets("357跨").Cells(4, i)
Worksheets("辅助").Cells(hang51, 15) = Worksheets("357跨").Cells(5, i)
hang51 = hang51 + 1
End If
If Y = 5 Then
Worksheets("辅助").Cells(hang5, 16) = Worksheets("357跨").Cells(1, i)
Worksheets("辅助").Cells(hang5, 17) = Worksheets("357跨").Cells(2, i)
Worksheets("辅助").Cells(hang5, 18) = Worksheets("357跨").Cells(3, i)
Worksheets("辅助").Cells(hang5, 19) = Worksheets("357跨").Cells(4, i)
Worksheets("辅助").Cells(hang5, 20) = Worksheets("357跨").Cells(5, i)
hang5 = hang5 + 1
End If
End If
Next
Calculate
MsgBox "恭喜，程序运行结束！已经成功匹配！"
End Sub

Answer 1

Private Sub CommandButton3_Click()
hang7 = 6
hang6 = 6
hang51 = 6
hang5 = 6
dangri = TextBox1.Text
If Trim(TextBox1.Text) = "" Then
MsgBox "不能为空"
Exit Sub
ElseIf IsNumeric(Trim(dangri)) = False Then
 MsgBox "请输入数字"
 Exit Sub
End If
MsgBox "程序开始运行，您千万务必不要进行表格的任何操作，运算结束，程序自有提示！！点击确定将开始匹配"
Worksheets("辅助").Range("A6:CV15000").ClearContents
Application.ScreenUpdating = False
For i = 26 To 6833
 hang = TextBox1.Text
  Y = 0
 If Worksheets("357跨").Cells(TextBox1.Text, i).Interior.ColorIndex = 3 Then
     Do While Worksheets("357跨").Cells(hang, i).Interior.ColorIndex = 3
       Y = Y + 1
        hang = TextBox1.Text - Y
     Loop
  If Y = 7 Then
   Worksheets("辅助").Cells(hang7, 1) = Worksheets("357跨").Cells(1, i)
   Worksheets("辅助").Cells(hang7, 2) = Worksheets("357跨").Cells(2, i)
   Worksheets("辅助").Cells(hang7, 3) = Worksheets("357跨").Cells(3, i)
   Worksheets("辅助").Cells(hang7, 4) = Worksheets("357跨").Cells(4, i)
   Worksheets("辅助").Cells(hang7, 5) = Worksheets("357跨").Cells(5, i)
       hang7 = hang7 + 1
     End If
     If Y = 6 Then
   Worksheets("辅助").Cells(hang6, 6) = Worksheets("357跨").Cells(1, i)
   Worksheets("辅助").Cells(hang6, 7) = Worksheets("357跨").Cells(2, i)
   Worksheets("辅助").Cells(hang6, 8) = Worksheets("357跨").Cells(3, i)
   Worksheets("辅助").Cells(hang6, 9) = Worksheets("357跨").Cells(4, i)
   Worksheets("辅助").Cells(hang6, 10) = Worksheets("357跨").Cells(5, i)
        hang6 = hang6 + 1
     End If
     If Y = 5 Then
     Worksheets("辅助").Cells(hang5, 16) = Worksheets("357跨").Cells(1, i)
     Worksheets("辅助").Cells(hang5, 17) = Worksheets("357跨").Cells(2, i)
     Worksheets("辅助").Cells(hang5, 18) = Worksheets("357跨").Cells(3, i)
     Worksheets("辅助").Cells(hang5, 19) = Worksheets("357跨").Cells(4, i)
     Worksheets("辅助").Cells(hang5, 20) = Worksheets("357跨").Cells(5, i)
        hang5 = hang5 + 1
     If Worksheets("357跨").Cells(hang - 1, i).Interior.ColorIndex = 3 Then
     Worksheets("辅助").Cells(hang51, 11) = Worksheets("357跨").Cells(1, i)
     Worksheets("辅助").Cells(hang51, 12) = Worksheets("357跨").Cells(2, i)
     Worksheets("辅助").Cells(hang51, 13) = Worksheets("357跨").Cells(3, i)
     Worksheets("辅助").Cells(hang51, 14) = Worksheets("357跨").Cells(4, i)
     Worksheets("辅助").Cells(hang51, 15) = Worksheets("357跨").Cells(5, i)
     hang51 = hang51 + 1
     End If
     End If
End If
  Next
  Application.ScreenUpdating = True
   Calculate
MsgBox "恭喜，程序运行结束！已经成功匹配！"
End Sub