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：使用VBA進行強大的編程”和相當多的Web資源（包括這個很棒的網站）來研究了此主題，但是無法在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行開始，一直持續到在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 2

只需添加一個變量來跟蹤活動行，然后使用它代替常量1。

例如

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

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