excel vba拆分文本

Question

请注意，我正在使用一系列约 1000 行的医疗信息数据库。由于数据库的大小，手动操作数据过于耗时。因此，我尝试学习 VBA 并使用 VBA 编写 Excel 2010 宏来帮助我完成对某些数据的解析。所需的输出是从数据库每一行提供的字符串中拆分某些字符，如下所示：

99204 - 办公室/门诊，新

需要拆分成

Active Row Active Column = 99204 ActiveRow Active Column+3 = OFFICE/OUTPATIENT VISIT, NEW

我使用 Walkenbach 的“Excel 2013：Power Programming with VBA”和大量网络资源（包括这个很棒的网站）研究了这个主题，但无法在 Excel 中使用 VBA 开发一个完全可行的解决方案。我当前宏的代码是：

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，因为在某些输入字符串中存在多个“-”字符）。我已经修剪了第二个字符串输出以删除前导空格。

我遇到的问题是输出显示在活动表的顶部，而不是活动行。

提前感谢您的帮助。我已经为此工作了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）跳过所有粗体单元格，直到它碰到一个空单元格。

Answer 1

只需添加一个变量来跟踪活动行，然后用它代替常量 1。

例如

Dim iRow as Integer =  ActiveCell.Row
For a = 0 To 1
     Cells(iRow , a + 3).Value = Trim(name(a))
Next a

Answer 2

修改后的请求的修改答案。 这将从第 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

Answer 3

利用 TextToColumns 的替代方法。此代码还避免使用循环，使其更高效、更快。已添加注释以帮助理解代码。

编辑：我通过使用临时工作表扩展了代码以使其更加通用。然后，您可以将这两列输出到您想要的任何位置。如您最初的问题所述，现在输出到第 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

Answer 4

您可以在不循环的情况下一次性完成此操作，使用 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