VBA L oop предназначен для разделения текста и очень медленный (возможно, не отвечает). Вам нужна помощь по улучшению?

Question

Внутри столбцов A1: все A10000 заполнены строкой из 18 символов Например: AAAAAAAAAAAAAAAAA

Следующий VBA поможет разделить их на соответствующие столбцы в соответствии с заданной c необходимой длиной символа. Однако VBA может не отвечать из-за большого объема информации. Нужна помощь по улучшению?

Sub looptest()
    Dim rng As Range
    Dim cCel As Range
    Dim i As Long

Set rng = Range("A1: A10000")

   i = 1


    For Each cCel In rng
        Cells(i, 2).Value = Left(Cells(i, 1).Value, 2)
        Cells(i, 3).Value = Mid(Cells(i, 1).Value, 3, 1)
        Cells(i, 4).Value = Mid(Cells(i, 1).Value, 4, 2)
        Cells(i, 5).Value = Mid(Cells(i, 1).Value, 6, 1)
        Cells(i, 6).Value = Mid(Cells(i, 1).Value, 7, 2)
        Cells(i, 7).Value = Mid(Cells(i, 1).Value, 9, 2)
        Cells(i, 8).Value = Mid(Cells(i, 1).Value, 11, 3)
        Cells(i, 9).Value = Mid(Cells(i, 1).Value, 14, 1)
        Cells(i, 10).Value = Mid(Cells(i, 1).Value, 15, 3)
        Cells(i, 11).Value = Mid(Cells(i, 1).Value, 16, 1)
        i = i + 1
    Next cCel


End Sub

Answer 1

Вам не нужно все oop

Sub NoLoop()

    TurnOffFunctionality()

    Range("O1") = Now()  ' start time

    Range("B1:B10000").Formula = "=Left(RC[-1],2)"
    Range("C1:C10000").Formula = "=Mid(RC[-2],3,1)"
    Range("D1:D10000").Formula = "=Mid(RC[-3],4,2)"
    Range("E1:E10000").Formula = "=Mid(RC[-3],6,1)"
    ' Leave it to the OP to continue

    ' and if you want the values only uncomment the following line
    ' Range("B1:E10000").Value = Range("B1:E10").Value


   TurnOnFunctionality

End Sub

И если вы хотите ускорить это, вы также можете сначала отключить некоторые функции со следующим кодом

' Procedure : TurnOffFunctionality
' Source    : www.TheExcelVBAHandbook.com
' Author    : Paul Kelly
' Purpose   : Turn off automatic calculations, events and screen updating
Private Sub TurnOffFunctionality()
    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
End Sub

' Procedure : TurnOnFunctionality
' Source    : www.TheExcelVBAHandbook.com
' Author    : Paul Kelly
' Purpose   : turn on automatic calculations, events and screen updating
Private Sub TurnOnFunctionality()
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Answer 2

Быстрое использование варианта массива.

Sub test()
    Dim rng As Range
    Dim i As Long, n As Long
    Dim vDB As Variant, vR() As Variant
    Set rng = Range("A1: A10000")
    vDB = rng

    n = UBound(vDB, 1)
    ReDim Preserve vR(1 To n, 1 To 10)

    For i = 1 To n
        vR(i, 1) = Left(vDB(i, 1), 2)
        vR(i, 2) = Mid(vDB(i, 1), 3, 1)
        vR(i, 3) = Mid(vDB(i, 1), 4, 2)
        vR(i, 4) = Mid(vDB(i, 1), 6, 1)
        vR(i, 5) = Mid(vDB(i, 1), 7, 2)
        vR(i, 6) = Mid(vDB(i, 1), 9, 2)
        vR(i, 7) = Mid(vDB(i, 1), 11, 3)
        vR(i, 8) = Mid(vDB(i, 1), 14, 1)
        vR(i, 9) = Mid(vDB(i, 1), 15, 3)
        vR(i, 10) = Mid(vDB(i, 1), 16, 1)
    Next i
    Range("b1").Resize(n, 10) = vR
End Sub

Answer 3

Перед для l oop добавьте

Application.ScreenUpdating = False

и после этого

Application.ScreenUpdating = True