Всем привет! Пытаюсь использовать код господина Msi2102 из этой темы для преобразования выгрузки из 1с в плоскую таблицу, и в 365 офисе все ок, но коллеги запускали в 2013 и 2016 и он зависает на цикле 14-16 строчки
Код
Sub Макрос1()
Dim arr As Variant, arr1 As Variant, n As Long, m As Integer
arr1 = Selection.Columns("A:A")
ReDim arr(1 To UBound(arr1), 1 To 1)
Set Dict = CreateObject("System.Collections.ArrayList")
For Each r In Selection.Rows
n = n + 1
If Not Dict.contains(r.OutlineLevel) Then
Dict.Add r.OutlineLevel
If Dict.Count > 1 Then ReDim Preserve arr(1 To UBound(arr), 1 To UBound(arr, 2) + 1)
End If
arr(n, Dict.LastIndexOf(r.OutlineLevel) + 1) = arr1(n, 1)
If Dict.LastIndexOf(r.OutlineLevel) + 1 > 1 And n > 1 Then
For m = Dict.LastIndexOf(r.OutlineLevel) To 1 Step -1
arr(n, m) = arr(n - 1, m)
Next
End If
Next
Columns(1).Resize(, Dict.Count).Insert Shift:=xlToRight
Selection(1).Resize(UBound(arr), UBound(arr, 2)).NumberFormat = "@"
Selection(1).Resize(UBound(arr), UBound(arr, 2)) = arr
End Sub
ну вот, дожили до господина😁😁😁 К сожалению в ближайшие время ни чем помочь не смогу, временно отсутствует доступ к компу. Думаю господин doober, прав. Возможно есть смысл избавится от Selection