Цикл массива замедляется с очень большими массивами. Что я могу сделать, чтобы ускорить это?

Question

У меня есть макрос, который создает очень длинную строку, проходя через двумерный массив, который иногда может содержать 30000 строк. Это может занять полчаса или больше. Есть ли способ ускорить это? Он вытягивает электронную таблицу в массив, а затем создает другой массив с этой информацией. Эта часть не имеет проблем.

Она замедляется при циклическом просмотре второго массива, который создает одну очень длинную строку, которая используется для создания текстового файла.

Agingarray = XLSbk.Sheets("Aging_Report").Range("A4").CurrentRegion
ReDim FirstArray(1 To UBound(Agingarray) * UBound(Agingarray, 2) * 31, 1 To 8)
i = 1
For x = 2 To UBound(Agingarray)
    For y = 4 To LastCol
        If Agingarray(x, y) > 50 Then
        If Trim(Agingarray(x, 2)) = "" Then Exit For
            MI = ""
            If InStr(1, Agingarray(x, 2), ",") > 0 Then
                Namestr = Split(Agingarray(x, 2), ",")
                LastName = Trim(Namestr(0))
                Fname = Split(Trim(Namestr(1)), " ")
                If Trim(Namestr(1)) <> "" Then
                    NameFirst = Trim(Fname(0))
                    If UBound(Fname) = 1 Then
                        MI = Trim(Fname(1))
                    End If
                Else
                    NameFirst = ""
                End If
            Else
                LastName = Trim(Agingarray(x, 2))
                NameFirst = ""
            End If

            Monthend = Application.WorksheetFunction.EoMonth(Agingarray(1, y), 0)
            For j = Agingarray(1, y) To Monthend
                FirstArray(i, 1) = LastName
                FirstArray(i, 2) = NameFirst
                FirstArray(i, 3) = MI
                FirstArray(i, 4) = Agingarray(x, LastCol + 6)
                FirstArray(i, 5) = Format(Agingarray(x, LastCol + 8), "000000000")
                FirstArray(i, 6) = Agingarray(x, LastCol + 9)
                FirstArray(i, 7) = Agingarray(x, LastCol + 10)
                FirstArray(i, 8) = j
                i = i + 1
            Next j
        End If
    Next y
Next x

This это часть кода, которая замедляется.

For x = LBound(FirstArray) To UBound(FirstArray)
    If FirstArray(x, 1) = "" Then Exit For
    Body = Body & "HL*" & h & "*1*21*1~" & PrvLine & "HL*" & i & "*" & j & "*22*0~" & _
    "TRN*1*" & Format(Now, "hhmmss") & k & "*" & 9100000000# + k & "*00309417~" & _
    "NM1*IL*1*" & FirstArray(x, 1) & "*" & FirstArray(x, 2) & "*" & FirstArray(x, 3) & "***"
    If Trim(FirstArray(x, 4)) <> "" Then
        Body = Body & "MI*" & Trim(FirstArray(x, 4)) & "~"
        LineCount = LineCount + 8
    Else
        Body = Body & "*~REF*SY*" & Trim(Format(FirstArray(x, 5), "000000000")) & "~"
        LineCount = LineCount + 9
    End If
    Body = Body & "DMG*D8*" & Trim(Format(FirstArray(x, 6), "yyyymmdd")) & "*" & Trim(FirstArray(x, 7)) & "~" & _
    "DTP*291*D8*" & Format(FirstArray(x, 8), "yyyymmdd") & "~" & _
    "EQ*30~"
    h = h + 2
    i = i + 2
    j = j + 2
    k = k + 1
Next x