Excel-VBA：從字母數字獲取數值

Question

我有一列（列A）包含字母數字文本，我想讀取它並將其寫回到另一列（列C）。 該代碼是;

Sub getnumber()

'Define Variable
Dim anicode As Variant
Dim n As Long
Dim lastrowdata As Long

'Data Location
Sheets("Sheet1").Activate
lastrowdata = range("A2").end(xlDown).Row - 1

'Redefine Array
ReDim anicode(lastrowdata)

'Read Data
For n = 1 To lastrowdata
  anicode(n) = Sheets("Sheet1").Cells(1 + n, 1)
Next n

'Altering Data
For n = 1 To lastrowdata
  If IsNumeric(anicode(n)) Then
     anicode(n) = NumericOnly
  Else
  End If
Next n

'Write Data
For n = 1 To lastrowdata
  Sheets("Sheet1").Cells(1 + n, 3) = anicode(n)
Next n

End Sub

我被困在“ Altering Data部分，我只想從文本中獲取價值。 我只是VBA中的新手，並且目前僅了解IsNumeric函數。 在A列中，數據是字母數字的並且是隨機的，其中的數據可能帶有破折號（-）或空格（），甚至混雜有字母，例如S2或X4。 數據可能只有數字（因為數據長約8k，並且會不斷增長）。

作為例子； 在A欄，我有

R1-Adapa S2
R2-Adapa S2
R3-Omis 14
R4-189

在C列中，我只想使用數字

R1-002
R2-002
R3-014
R4-189

感謝有關我的問題或我的代碼的任何可能的功能或意見。 謝謝stackoverflow.com

Answer 1

我對宏的處理會有所不同

• 將原始數據讀取到vba宏中以提高處理速度
• 使用正則表達式獲取字符串的相關部分
• 格式化終端數字以使其具有適當的前導零數字
• 將結果寫入另一個VBA陣列-再次提高速度。
• 將結果寫回到工作表並設置其格式。
• 根據需要格式化結果

例如：

Option Explicit
Sub getnumber()
    Dim wsSrc As Worksheet
    Dim vSrc As Variant, vRes As Variant
    Dim rRes As Range
    Dim I As Long

Set wsSrc = Worksheets("sheet1")
With wsSrc

'set results area
    Set rRes = .Cells(1, 3)

'Read data into array for faster processing
    vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With

'create results array
ReDim vRes(1 To UBound(vSrc), 1 To 1)

'Fill vres with the converted data
For I = 1 To UBound(vRes, 1)
    vRes(I, 1) = reFormat(vSrc(I, 1))
Next I

'Size the results range
Set rRes = rRes.Resize(rowsize:=UBound(vRes, 1))

'Clear the area and write the new data
With rRes
    .EntireColumn.Clear

   'In case a value is solely numeric, as in A5 of example
    .NumberFormat = "@"

    .Value = vRes
    .EntireColumn.AutoFit
    .Style = "Output"
End With

End Sub



Function reFormat(ByVal S As String) As String
    Dim RE As Object, MC As Object

Set RE = CreateObject("vbscript.regexp")
With RE
    .Global = True
    .MultiLine = True
    .Pattern = "(^\D\d+-)?\D*(\d+)"
    If .test(S) = True Then
        Set MC = .Execute(S)
        With MC(0)
            reFormat = .submatches(0) & Format(.submatches(1), "000")
        End With
    End If
End With

End Function

這是正則表達式模式的簡要說明：

（^ \\ D \\ d +-）？\\ D *（\\ d +）

(^\D\d+-)?\D*(\d+)

選項：區分大小寫； ^ $在換行符匹配

• 匹配下面的正則表達式並將其匹配捕獲到反向引用號1 (^\\D\\d+-)?
  • 在零到一遍之間，盡可能多地遍歷，並根據需要進行回饋（貪婪） ?
  • 在字符串的開頭聲明位置 ^
  • 匹配不是“數字” \\D 的單個字符
  • 匹配單個字符，即“數字” \\d+
    • 在一次和無限次之間，盡可能多次，根據需要進行回饋（貪婪） +
  • 從字面上匹配字符“-” -
• 匹配不是“數字” \\D* 的單個字符
  • 在0到無限制的時間之間，盡可能多次，並根據需要進行回饋（貪婪） *
• 匹配下面的正則表達式，並將其匹配捕獲到反向引用編號2 (\\d+)
  • 匹配單個字符，即“數字” \\d+
    • 在一次和無限次之間，盡可能多次，根據需要進行回饋（貪婪） +

用RegexBuddy創建

Answer 2

使用該來源，我想到了：

=LEFT(A1,3)&TEXT(MID(SUMPRODUCT(MID(0&A1,LARGE(INDEX(ISNUMBER(--MID(A1,ROW(INDIRECT("1:"&LEN(A1))),1))*ROW(INDIRECT("1:"&LEN(A1))),0),ROW(INDIRECT("1:"&LEN(A1))))+1,1)*10^ROW(INDIRECT("1:"&LEN(A1)))/10),2,LEN(A1)),"000")

這使我從提供的示例中獲得了預期的結果。

Answer 3

為了完成任務，您將需要其他功能，這將使代碼更容易，更干凈：

首先，該函數僅從給定的字符串中提取數字：

Function OnlyNumbers(word As String) As String
    Dim i As Long, ascIdx As Long
    OnlyNumbers = ""
    For i = 1 To Len(word)
        'if it's letter then append it to a returned word
        If IsNumeric(Mid(word, i, 1)) Then
            OnlyNumbers = OnlyNumbers + Mid(word, i, 1)
        End If
    Next
End Function

第二，我們需要函數，如果需要的話，它將以零開頭：

Function LeadingZeros(word As String, outputLength As Long) As String
    Dim i As Long
    LeadingZeros = ""
    For i = 1 To outputLength - Len(word)
        LeadingZeros = LeadingZeros + "0"
    Next
    LeadingZeros = LeadingZeros + word
End Function

最終，我們編寫了一個sub，它執行復制：

Sub CopySpecial()
    Dim ws As Worksheet, lastRow As Long, i As Long, hyphenIdx As Long
    'always set reference to main sheet, so you can use it in range references
    Set ws = Sheets("Arkusz1")
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    For i = 1 To lastRow
        code = Cells(i, 1).Value
        hyphenIdx = InStr(1, code, "-")
        'set the text formatting, so leading zeroes won't be truncated
        Cells(i, 3).NumberFormat = "@"
        If hyphenIdx = 0 Then
            Cells(i, 3).Value = LeadingZeros(OnlyNumbers(Cells(i, 1).Value), 3)
        Else
            Cells(i, 3).Value = Mid(code, 1, hyphenIdx) + LeadingZeros(OnlyNumbers(Mid(code, hyphenIdx + 1)), 3)
        End If
    Next

End Sub

Answer 4

也可以使用以下數組公式（ CTRL + SHIFT + ENTER ）

=TEXT(MAX(IFERROR(MID(" "&A3,ROW($A$1:$A$99),COLUMN($A$1:$CU$1))+0,0)),"000")

注意：公式限制為99個字符，但是如果存在的單元格超過99個，則可以輕松地將其擴展。