[已解决]帮忙优化代码，提高运行速度！

楚雪飞扬

Sub 匹配()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim i, f, ary, arr, arr2, arr3
    With Sheets(1)
        ary = Range("a65536").End(xlUp).Row
        arr = Range("A1", [A65536].End(xlUp))
        ReDim arr2(1 To UBound(arr), 1 To 1)
        ReDim arr3(1 To UBound(arr), 1 To 1)
        For i = 2 To UBound(arr)
            arr2(i, 1) = Mid(arr(i, 1), 4, 1) & Mid(arr(i, 1), 6, 1)
        Next
        [d1].Resize(i - 1, 1) = arr2
        For i = 2 To UBound(arr)
            arr2(i, 1) = Mid(arr(i, 1), 3, 1) & Mid(arr(i, 1), 6, 1)
        Next
        [E1].Resize(i - 1, 1) = arr2
        For y = 2 To ary
            arr3(y, 1) = Cells(y, 2) & Cells(y, 5)
        Next
        [F1].Resize(i - 1, 1) = arr3
        For y = 2 To ary
            arr3(y, 1) = Cells(y, 2) & Cells(y, 4)
        Next
        [G1].Resize(i - 1, 1) = arr3
        .[d1].Resize(1, 4) = Array("是否4寸量产", "是否A3", "A3良率", "4/6寸良率")
    End With
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

最佳答案

月排行榜 / 总排行榜

cutecpu

2021-4-21 19:16

Sub demo()
   With Sheets(1)
      ab = Range("A2", [B65536].End(xlUp))
      ReDim dg(1 To UBound(ab), 1 To 4)
      For i = 1 To UBound(ab)
         dg(i, 1) = Mid(ab(i, 1), 4, 1) & Mid(ab(i, 1), 6, 1)
         dg(i, 2) = Mid(ab(i, 1), 3, 1) & Mid(ab(i, 1), 6, 1)
         dg(i, 3) = ab(i, 2) & dg(i, 2)
         dg(i, 4) = ab(i, 2) & dg(i, 1)
      Next
      [D2].Resize(i - 1, 4) = dg
   End With
End Sub

祝順心，南無阿彌陀佛！

跳转到最佳答案楼层

cutecpu

Sub demo()
   With Sheets(1)
      ab = Range("A2", [B65536].End(xlUp))
      ReDim dg(1 To UBound(ab), 1 To 4)
      For i = 1 To UBound(ab)
         dg(i, 1) = Mid(ab(i, 1), 4, 1) & Mid(ab(i, 1), 6, 1)
         dg(i, 2) = Mid(ab(i, 1), 3, 1) & Mid(ab(i, 1), 6, 1)
         dg(i, 3) = ab(i, 2) & dg(i, 2)
         dg(i, 4) = ab(i, 2) & dg(i, 1)
      Next
      [D2].Resize(i - 1, 4) = dg
   End With
End Sub

祝順心，南無阿彌陀佛！

楚雪飞扬

cutecpu 发表于 2021-4-21 19:16
Sub demo()
   With Sheets(1)
      ab = Range("A2", .End(xlUp))

这个代码简单多了，感谢帮忙！