Код VBA для текста в столбец - фиксированная ширина цикла - PullRequest
Новая
       63

Код VBA для текста в столбец - фиксированная ширина цикла

0 голосов
/ 15 января 2020

Я ищу способ сделать мой код более простым, более эффективным и создать al oop, который будет работать, пока не достигнет последнего символа.

Сначала я получаю данные, которые всегда выглядят как в примере ниже и должен быть вставлен в строку (обычно ячейка A1):

7666976-15012020092737.pdf; 7665725-15012020092757.pdf; 7669477-15012020092833.pdf; 7669483-15012020092844.pdf; 7669492-15012020092857.pdf; 7669494-15012020092910.pdf; 7669495-15012020092921.pdf; 7669546-15012020092933.pdf; 7669548-15012020092953.pdf; 7669548-15012020093010.pdf; 7669551-15012020093047.pdf; 7669552-15012020093111.pdf; 7669554-15012020093138.pdf; 7669557-15012020093205.pdf; 7669558-15012020093245.pdf; 7669563-15012020093311.pdf; 7672877-15012020093344.pdf; 7672879-15012020093401.pdf; 7672881-15012020093415.pdf; 7672882-15012020093425.pdf; 7672884-15012020093437.pdf

Затем я разделяю его с помощью параметра «Текст в столбец - фиксированная ширина» в Excel. Длина каждого фрагмента всегда должна составлять 28 символов.

Пока что мне удалось создать приведенный ниже код, который работает, но я считаю, что он может быть лучше - например, если есть 1000 символов, я должен продолжать добавлять массив (728,1), Array (756,1) и др. c. к коду. 

Range("A1").Select
    Selection.TextToColumns Destination:=Range("S1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(28, 1), Array(56, 1), Array(84, 1), Array(112, 1), _
        Array(140, 1), Array(168, 1), Array(196, 1), Array(224, 1), Array(252, 1), Array(280, 1), _
        Array(308, 1), Array(336, 1), Array(364, 1), Array(392, 1), Array(420, 1), Array(448, 1), _
        Array(476, 1), Array(504, 1), Array(532, 1), Array(560, 1), Array(588, 1), Array(616, 1), _
        Array(642, 1), Array(672, 1), Array(700, 1)), TrailingMinusNumbers:=True

Не могли бы вы посоветовать, как его можно улучшить?

Заранее спасибо.

Ответы [ 2 ]

2 голосов
/ 15 января 2020

Вам необходимо использовать оба разделителя (т. Е. Точку с запятой и пробел)

Попробуйте это: 

With ThisWorkbook.Sheets("TEST")
    .Cells(1).TextToColumns Destination:=Range("S1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, _
        Semicolon:=True, Space:=True
    .Range("S1").CurrentRegion.Columns.AutoFit
End With
2 голосов
/ 15 января 2020

Как уже упоминалось в комментариях, вы можете просто использовать функцию Split: 

Sub Test()

Dim arr As Variant

With Sheet1 'Change according to your sheet's codename
    arr = Split(.Range("A1").Value, "; ")
    .Range("S1").Resize(, UBound(arr) + 1).Value = arr
End With

End Sub

Хотя Range.TextToColumns тоже неплохо. Поскольку вы на самом деле хотели разделить символом ; вместо точки с запятой, было два * параметра:

  • Удалите пробелы / точки с запятой из вашего сначала исходная строка: 

    Sub Test

With Sheet1 'Change according to your sheet's codename
    .Range("A1").Value = .Range("A1").Replace(" ", "")
    .Range("A1").TextToColumns .Range("S1"), DataType:=1, Semicolon:=True
End With

End Sub

  • Используйте Application.Trim сразу после запуска кода, чтобы удалить начальные / конечные пробелы сразу из всех ячеек: 

    Sub Test

With Sheet1 'Change according to your sheet's codename
    .Range("A1").TextToColumns .Range("S1"), DataType:=1, Semicolon:=True
    Application.Trim (.Rows(1))
End With

End Sub

Последнее не повлияет на ваше значение A1, поэтому вам может потребоваться go.

* Примечание: Настройка ConsecutiveDelimiter to True позволяет использовать несколько разделителей согласно @EEM его ответ .

...