需要將Excel VBA中的值拆分成兩個單元格

Question

我有一個相當簡單的問題。 我只是無法為我的生活弄清楚如何做到這一點。

我在 Excel 中有一系列單元格，如下所示：

Row  ColA
1    B001
2    B002
3    B003
4    B004
5    B005

我需要知道如何在 VBA 中拆分這些單元格，以便它們現在像這樣：

   ColB  ColC
1   B   001
2   B   002
3   B   003
4   B   004
5   B   005

我知道你在 VBA 中使用了 SPLIT 命令，但我很難知道如何填寫 rest。有人可以幫忙嗎？

這是一張圖片來幫助描述我在 Excel 中擁有/需要的東西

在此處輸入圖像描述

Answer 1

解析數字文本

測試 1

Option Explicit

Sub Test1()
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim rg As Range: Set rg = ws.Range("A1").CurrentRegion.Columns(1)
    
    ' If there are headers:
    'Set rg = rg.Resize(rg.Rows.Count - 1).Offset(1)
    
    Dim Data As Variant: Data = rg.Value
    ReDim Preserve Data(1 To UBound(Data, 1), 1 To 2)
    Dim r As Long
    For r = 1 To UBound(Data, 1)
        Data(r, 2) = Right(Data(r, 1), 3)
        Data(r, 1) = Left(Data(r, 1), 1)
    Next r
    
    With rg.Offset(, 1).Resize(, 2)
        .Columns(2).NumberFormat = "@"
        .Value = Data
    End With
    
End Sub

測試 2（不弄亂數字格式）

Sub Test2()
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim rg As Range: Set rg = ws.Range("A1").CurrentRegion.Columns(1)
    
    ' If there are headers:
    'Set rg = rg.Resize(rg.Rows.Count - 1).Offset(1)
    
    rg.Offset(, 1).Value = ws.Evaluate("LEFT(" & rg.Address & ",1)")
    rg.Offset(, 2).Value = ws.Evaluate("""'"" & RIGHT(" & rg.Address & ",3)")
    
End Sub

測試 3（使用TextToColumns而不會弄亂數字格式）

Sub Test3()
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim rg As Range: Set rg = ws.Range("A1").CurrentRegion.Columns(1)
    
    ' If there are headers:
    'Set rg = rg.Resize(rg.Rows.Count - 1).Offset(1)
    
    'Application.DisplayAlerts = False ' overwrite without confirmation
    rg.TextToColumns Destination:=rg.Offset(, 1), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 2), Array(1, 2))
    'Application.DisplayAlerts = True

End Sub

兩個 ( 2 ) 表示As Text ，零 ( 0 ) 表示第一個字符（在第 0 個字符之后），一個 ( 1 ) 表示在第一個字符之后。