excel vba拆分文本
请注意，我正在使用一系列〜1000行的医疗信息数据库。 由于数据库的大小，手动操作数据太耗时。 因此，我曾试图学习VBA并使用VBA编写Excel 2010macros，以帮助我完成分析某些数据的工作。 所需的输出是从数据库的每一行提供的string中拆分某些字符，如下所示：
99204 – 办公室/门诊访问，新的
将需要分成
Active Row Active Column = 99204 ActiveRow Active Column + 3 = OFFICE / OUTPATIENT VISIT，NEW
我已经使用Walkenbach的“Excel 2013：使用VBA进行电源编程”和相当数量的networking资源（包括这个很棒的站点）研究了这个主题，但是一直没能在Excel中使用VBA开发一个完全可行的解决scheme。 我当前macros的代码是：
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 代码使用“ – ”字符作为分隔符将inputstring拆分为两个子string（我将输出string限制为2，因为在某些inputstring中存在多个“ – ”字符）。 我已经修剪了第二个string输出以删除前导空格。
我遇到的麻烦是输出显示在activesheet的顶部，而不是在activerow上。
预先感谢您的任何帮助。 我已经做了2天的工作，虽然取得了一些进展，但我觉得我已经陷入了僵局。 我认为这个问题在某个地方
Cells(1, a + 3).Value = Trim(name(a))
代码，特别是“Cells（）”。
谢谢Conrad Frix！
Yah ..够搞笑的 就在我发布后，我有一个头脑风暴..并修改代码来阅读：
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输出（它输出到第3列，第4列），但它将适用于我的目的。
现在我需要合并一个循环，以便代码在列中的每个连续单元格上运行（向下，步骤1），跳过所有粗体单元格，直到它碰到空单元格。
修改后的请求的答案。 这将从第1行开始并继续，直到在列A中find一个空白单元格为止。如果你想从另一行开始，也许在第2行，如果你有头，更改
i = 1
行到
i = 2
在进行输出写入之前，我在variables的上限中添加了一个检查，以防再次在已格式化的单元格上运行macros。 （没有任何东西，而不是错误）
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
只需添加一个variables来跟踪活动行，然后使用它来代替常量1。
例如
Dim iRow as Integer = ActiveCell.Row For a = 0 To 1 Cells(iRow , a + 3).Value = Trim(name(a)) Next a
使用TextToColumns的替代方法。 这段代码也避免了使用循环，使其更有效，更快。 已添加注释以帮助理解代码。
编辑：我已经扩大了代码，使其更多function通过使用临时工作表。 然后，您可以将两列输出到任何你想要的地方。 正如你原来的问题所述，现在输出到第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
您可以一次性完成此操作，而无需使用input此公式的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