Excel VBA - разбить строки в диапазоне на пустое пространство, учитывая все ячейки в диапазоне - PullRequest
0 голосов
/ 07 марта 2019

Я извлекаю много таблиц из PDF, которые мне нужно импортировать в базу данных. Из-за добычи некоторые выходят довольно плохо.

* ** 1003 тысяча два * Пример

Я хотел бы иметь сценарий VBA, который проходит по всем ячейкам на листе, содержащем строки и разделяя их на пустое пространство, чтобы любые значения после пробела удалялись из ячейки и помещались в соседние ячейки справа. .

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

1 Ответ

0 голосов
/ 12 марта 2019

Похоже, вы изо всех сил пытаетесь получить ответ, поэтому я с радостью постараюсь помочь.

Создайте новый модуль в проекте VBA и добавьте следующий код ...

Public Sub SplitCells()
    Dim rngSrcData As Range, objDestSheet As Worksheet, lngRow As Long
    Dim lngCol As Long, arrSplit, arrData(), lngWriteRow As Long, lngIndex As Long
    Dim strDelimiter As String, i As Long, strWriteRange As String

    Set rngSrcData = Selection
    Set objDestSheet = Worksheets("Output")
    strDelimiter = " "

    objDestSheet.Cells.Clear

    With rngSrcData
        For lngRow = 1 To .Rows.Count
            lngIndex = 0

            For lngCol = 1 To .Columns.Count
                arrSplit = Split(CStr(.Cells(lngRow, lngCol)), strDelimiter, , vbTextCompare)

                For i = 0 To UBound(arrSplit)
                    ReDim Preserve arrData(lngIndex)
                    arrData(lngIndex) = arrSplit(i)

                    lngIndex = lngIndex + 1
                Next
            Next

            lngWriteRow = lngWriteRow + 1

            strWriteRange = .Cells(lngWriteRow, 1).Address & ":" & .Cells(lngWriteRow, UBound(arrData) + 1).Address
            objDestSheet.Range(strWriteRange) = arrData
        Next
    End With
End Sub

... вместе с вышеизложенным создайте новый лист в своей книге и назовите его « Вывод ». Это место назначения для преобразованных данных.

Теперь выберите весь диапазон данных (как показано на снимке экрана) и затем запустите макрос.

enter image description here

Проверьте свой «Выходной» лист, и вы должны увидеть свой результат.

Я надеюсь, что это работает для вас.

...