excel VBA разделить текст

Question

excel VBA разделить текст

Пожалуйста, имейте в виду, что я работаю с серией ~1000 линейных медицинских информационных баз данных. Из-за размера баз данных ручная обработка данных занимает слишком много времени. Таким образом, я попытался изучить VBA и закодировать макрос Excel 2010 с помощью VBA, чтобы помочь мне выполнить синтаксический анализ определенных данных. Желаемый результат состоит в том, чтобы разделить определенные символы из предоставленной строки на каждой строке базы данных следующим образом:

99204 - ОФИС/АМБУЛАТОРНОГО ПОСЕЩЕНИЯ, НОВЫЕ

Понадобится быть разделенным на

Активная строка активный столбец = 99204 ActiveRow активная колонка+3 = офис / амбулаторный визит, новый

Я исследовал эту тему с помощью Walkenbach "Excel 2013: Power Programming with VBA" и изрядного количества веб-ресурсов, включая этот удивительный сайт, но не смог разработать полностью работоспособное решение, используя VBA в Excel. Код для моего текущего макроса:

Sub EasySplit()

Dim text As String

Dim a As Integer

Dim name As Variant

text = ActiveCell.Value

name = Split(text, "-", 2)

For a = 0 To 1

Cells(1, a + 3).Value = Trim(name(a))

Next a

End Sub

Код использует символ " - " в качестве разделителя для разделения ввод строки в две подстроки (я ограничил выходные строки до 2, так как в некоторых входных строках существует несколько символов" -"). Я обрезал вторую строку вывода, чтобы удалить ведущие пробелы.

Проблема, с которой я сталкиваюсь, заключается в том, что выходные данные представлены в верхней части таблицы activesheet, а не в activerow.

Заранее благодарю вас за любую помощь. Я работал над этим в течение 2 дней, и хотя я сделал некоторый прогресс, я чувствую, что я достиг тупик. Я думаю, что проблема где-то в

Cells(1, a + 3).Value = Trim(name(a))

Код, в частности с " Cells ()".

Спасибо, Конрад Фрикс!

Да.. довольно забавно. Сразу после публикации у меня начинается мозговой штурм.. и измените код следующим образом:

Sub EasySplit()

Dim text As String

Dim a As Integer

Dim name As Variant

text = ActiveCell.Value

name = Split(text, "-", 2)

For a = 0 To 1

ActiveCell.Offset(0, 3 + a).Value = Trim(name(a))

Next a

End Sub

Не совсем вывод colkumn1, column4, который я хочу (он выводит в column3, column4), но он будет работать для моей цели.

Теперь мне нужно включить цикл, чтобы код выполнялся на каждой последующей ячейке в столбце (вниз, Шаг 1) пропускаем все выделенные жирным шрифтом ячейки, пока не попадем в пустую ячейку.

1008 4

excel string split vba

4 ответов:

Comments

Ничего не найдено.

Greg · Accepted Answer · 2014-07-12 01:58:29

Модифицированный ответ на модифицированный запрос. Это начнется с строки 1 и будет продолжаться до тех пор, пока пустая ячейка не будет найдена в столбце A. Если вы хотите начать с другой строки, возможно, строки 2, Если у вас есть заголовки, измените
i = 1
Строка в
i = 2
Я добавил проверку на верхней границе нашего варианта, прежде чем делать выходные записи, в случае, если макрос запускается снова на уже отформатированных ячейках. (Ничего не делает вместо того, чтобы ошибиться)
Sub EasySplit()
Dim initialText As String
Dim i As Double
Dim name As Variant
i = 1
Do While Trim(Cells(i, 1)) <> ""
    If Not Cells(i, 1).Font.Bold Then

        initialText = Cells(i, 1).text
        name = Split(initialText, "-", 2)
        If Not UBound(name) < 1 Then
            Cells(i, 1) = Trim(name(0))
            Cells(i, 4) = Trim(name(1))
        End If
    End If
    i = i + 1
Loop
End Sub

Conrad Frix · Accepted Answer · 2014-07-12 01:17:48

Просто добавьте переменную, чтобы отслеживать активную строку, а затем используйте ее вместо константы 1.

Например
Dim iRow as Integer =  ActiveCell.Row
For a = 0 To 1
     Cells(iRow , a + 3).Value = Trim(name(a))
Next a

tigeravatar · Accepted Answer · 2014-07-12 02:07:58

Альтернативный метод, использующий TextToColumns. Этот код также позволяет избежать использования цикла, что делает его более эффективным и намного быстрее. Комментарии были добавлены, чтобы помочь с пониманием кода.

EDIT: я расширил код, чтобы сделать его более универсальным с помощью временного листа. Затем вы можете вывести эти два столбца в любом месте, где вы хотите. Как указано в вашем первоначальном вопросе, теперь выходные данные относятся к столбцам 1 и 4.
Sub tgr()

    Const DataCol As String = "A"   'Change to the correct column letter
    Const HeaderRow As Long = 1     'Change to be the correct header row

    Dim rngOriginal As Range        'Use this variable to capture your original data

    'Capture the original data, starting in Data column and the header row + 1
    Set rngOriginal = Range(DataCol & HeaderRow + 1, Cells(Rows.Count, DataCol).End(xlUp))
    If rngOriginal.Row < HeaderRow + 1 Then Exit Sub 'No data

    'We will be using a temp worksheet, and to avoid a prompt when we delete the temp worksheet we turn off alerts
    'We also turn off screenupdating to prevent "screen flickering"
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    'Move the original data to a temp worksheet to perform the split
    'To avoid having leading/trailing spaces, replace all instances of " - " with simply "-"
    'Lastly, move the split data to desired locations and remove the temp worksheet

    With Sheets.Add.Range("A1").Resize(rngOriginal.Rows.Count)
        .Value = rngOriginal.Value
        .Replace " - ", "-"
        .TextToColumns .Cells, xlDelimited, Other:=True, OtherChar:="-"
        rngOriginal.Value = .Value
        rngOriginal.Offset(, 3).Value = .Offset(, 1).Value
        .Worksheet.Delete
    End With

    'Now that all operations have completed, turn alerts and screenupdating back on
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

brettdj · Accepted Answer · 2014-07-12 06:04:44

Вы можете сделать это за один кадр без цикла, используя VBA эквивалент ввода этой формулы, а затем принимая значения только

как формула

=IF(NOT(ISERROR(FIND("-",A1))),RIGHT(A1,LEN(A1)-FIND("-",A1)-1 ),A1)

код
Sub Quicker()
Dim rng1 As Range
Set rng1 = Range([a1], Cells(Rows.Count, "A").End(xlUp))
With rng1.Offset(0, 3)
    .FormulaR1C1 = "=IF(NOT(ISERROR(FIND(""-"",RC[-3]))),RIGHT(RC[-3],LEN(RC[-3])-FIND(""-"",RC[-3])-1 ),RC[-3])"
    .Value = .Value
End With
End Sub