excel vba 拆分文本

excel vba split text

提问by Aron Goldstein

Please be aware that I am working with a series of ~1000 line medical information databases. Due to the size of the databases, manual manipulation of the data is too time consuming. As such, I have attempted to learn VBA and code an Excel 2010 macro using VBA to help me accomplish parsing certain data. The desired output is to split certain characters from a provided string on each line of the database as follows:

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

99204 - OFFICE/OUTPATIENT VISIT, NEW

99204 - 办公室/门诊，新

will need to be split into

将需要分成

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

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

I have researched this topic using Walkenbach's "Excel 2013: Power Programming with VBA" and a fair amount of web resources, including this awesome site, but have been unable to develop a fully-workable solution using VBA in Excel. The code for my current macro is:

我使用 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

The code uses the "-" character as a delimiter to split the input string into two substrings (I have limited the output strings to 2, as there exists in some input strings multiple "-" characters). I have trimmed the second string output to remove leading spaces.

该代码使用“-”字符作为分隔符将输入字符串拆分为两个子字符串（我将输出字符串限制为 2，因为某些输入字符串中存在多个“-”字符）。我已经修剪了第二个字符串输出以删除前导空格。

The trouble that I am having is that the output is being presented at the top of the activesheet, instead of on the activerow.

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

Thank you in advance for any help. I have been working on this for 2 days and although I have made some progress, I feel that I have reached an impasse. I think that the issue is somewhere in the

预先感谢您的任何帮助。我已经为此工作了2天，虽然取得了一些进展，但我觉得我陷入了僵局。我认为问题出在

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

code, specifically with "Cells()".

代码，特别是“Cells()”。

Thank you Conrad Frix!

谢谢康拉德·弗里克斯！

Yah.. funny enough. Just after I post I have a brainstorm.. and modify the code to read:

嗯.. 够有趣的。就在我发布后，我有一个头脑风暴..并修改代码以阅读：

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

Not quite the colkumn1,column4 output that I want (it outputs to column3,column4), but it will work for my purpose.

不是我想要的 colkumn1,column4 输出（它输出到 column3,column4），但它可以满足我的目的。

Now I need to incorporate a loop so that the code runs on each successive cell in the column (downwards, step 1) skipping all bolded cells, until it hits an empty cell.

现在我需要合并一个循环，以便代码在列中的每个连续单元格上运行（向下，第 1 步），跳过所有粗体单元格，直到遇到一个空单元格。

回答by Greg

Modified answer to modified request. This will start on row 1 and continue until a blank cell is found in column A. If you would like to start on a different row, perhaps row 2 if you have headers, change the

修改请求的修改答案。这将从第 1 行开始并继续，直到在 A 列中找到一个空白单元格。如果您想从不同的行开始，如果您有标题，可能是第 2 行，请更改

i = 1

line to

线到

i = 2

I added a check on the upper bound of our variant before doing the output writes, in case the macro is run again on already formatted cells. (Does nothing instead of erroring out)

在执行输出写入之前，我添加了对我们变体上限的检查，以防宏在已格式化的单元格上再次运行。（什么都不做，而不是出错）

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

回答by Conrad Frix

just add a variable to keep track of the active row and then use that in place of the constant 1.

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

e.g.

例如

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

回答by tigeravatar

Alternate method utilizing TextToColumns. This code also avoids using a loop, making it more efficient and much faster. Comments have been added to assist with understanding the code.

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

EDIT: I have expanded the code to make it more versatile by using a temp worksheet. You can then output the two columns to wherever you'd like. As stated in your original question, the output is now to columns 1 and 4.

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

回答by brettdj

You can do this in a single shot without looping using the VBAequivalent of entering this formula, then taking values only

您可以一次完成此操作而无需使用VBA等效于输入此公式然后仅取值的循环

as a formula

作为公式

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

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

code

代码

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