EXCEL VBA-從單元格提取數字並將其粘貼到兩個不同的列中？

Question

我有一個電子表格，其中包含A列中的隨機文本和數字，如下所示：

Column A

    Row 1 = 471806121601 5205569 - 0007 Standard White Toilet Tissue 27 
    Row 2 = 471814121601 5206177 - 0014 Premium White Toilet Tissue 6 
    Row 3 = 471814121601 5206178 - 0007 Premium White Toilet Tissue 27
    Row 4 = 471806121601 5206180 - 0014 Premium Kitchen Towel 2x75l 6 

我總共有大約2000行。 在每個單元格中，都有一個采購訂單編號（12位數字）和旁邊的項目編號（7位數字）。

我正在嘗試提取po編號並將其放入B列，然后提取項目編號並將其放入C列

Column B        Column C
471806121601    5205569 
471814121601    5206177 
471814121601    5206178 
471806121601    5206180 

這是我的代碼：

Option Explicit

Sub main()
Dim cell As Range
Dim arr As Variant, arrElem As Variant

With Worksheets("Orders") '<--| change "Strings" to your actual worksheet name
    For Each cell In .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
        arr = Split(Replace(cell.Value, "  ", " "), " ") '<--| change "A"'s to your actual relevant column index
        For Each arrElem In arr
          If IsNumeric(arrElem) Then
            If Len(arrElem) = 12 Then cell.Offset(0, 1).Value = arrElem
          End If
        Next arrElem
    Next cell
End With

Dim cell2 As Range
Dim arr2 As Variant, arrElem2 As Variant

With Worksheets("Orders") '<--| change "Strings" to your actual worksheet name
    For Each cell2 In .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
        arr2 = Split(Replace(cell2.Value, "  ", " "), " ") '<--| change "A"'s to your actual relevant column index
        For Each arrElem2 In arr2
          If IsNumeric(arrElem2) Then
            If Len(arrElem2) = 7 Then cell2.Offset(0, 3).Value = arrElem2
          End If
        Next arrElem2
    Next cell2
End With

End Sub

此代碼可以正常工作。 但是，這需要絕對的時間，並且一次只能做一行。

有更快的方法嗎？ 謝謝

Answer 1

如果您的PO和IN在col B中總是相同的長度

=MID(A2, 1, 12)

在C欄

=MID(A2, 14, 7)

但是，如果您的電話號碼更改了，但始終是上述的前兩個，

=MID(A2,1,FIND(" ",A2,1)-1)

和

=MID(A2, FIND(" ", A2, 1)+1, 7)

分別。

Answer 2

只需使用split(string,delimiter)(0)和(1)為什么要替換空格，只需將其用作delim。 如果行號在其中，則使用（1）和（2），或者您可以考慮split(split(input,"-")," ")可能快一點，但不確定。 另外，一旦完成，就不需要完成循環，因此請考慮使用標志，而不是下一個標志，盡管可以exit for

在公式方面，可以使用類似這樣的方法來完成

=MID(D1,FIND("é",SUBSTITUTE(D1," ","é",3)),FIND("é",SUBSTITUTE(D1," ","é",4))-FIND("é",SUBSTITUTE(D1," ","é",3)))

和

=MID(D1,FIND("é",SUBSTITUTE(D1," ","é",4)),FIND("é",SUBSTITUTE(D1," ","é",5))-FIND("é",SUBSTITUTE(D1," ","é",4)))