通过将每个单元格值拆分为由字符分隔的多个整数来创建一维数组，忽略其他字符

Question

从多列范围我想在一个过程中通过将每个单元格值（如果需要）拆分为多个字符串来创建一维数组？，转换？为整数。值将由特定字符分隔，也必须忽略其他字符

这... ..会导致 1、2、3、4、7、9、11、13、54、67

我现在正在使用的代码：

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False

Dim arr As Variant
arr = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Value   'Convert to 2-dim and use non numerical values from adjacent column, see "Excha.."

Dim varr As Variant
varr = Range("C1:E" & Range("A" & Rows.Count).End(xlUp).Row).Value  'Split if some of the cells contains multiple values delimited by character??

Dim M As Integer
M = Application.WorksheetFunction.Max(r.Offset(, 2))                'Exchange cell ref to Max(len("x2"

TextBox1.Text = ""

Dim x, y, match As Boolean, i As Integer, L As Integer

i = 1

For Each x In arr
    match = False
    For Each y In varr
        If x = y Then
            match = True
            Exit For
        End If
    Next y
    If Not match And Len(x) <> "" Then
        If i = 1 Then
            TextBox1.Text = x & ". " & Worksheets(1).Cells(x, 2).Value                                  'Exchange cell ref to "x2"
        Else
            TextBox1.Text = TextBox1.Text & String(L, " ") & x & ". " & Worksheets(1).Cells(x, 2).Value 'Exchange cell ref to "x2"
        End If
        L = M + 5 - (Len(Worksheets(1).Cells(x, 1).Value) + Len(Worksheets(1).Cells(x, 2).Value))       'Exchange cell ref to len(x)& len("x2")
    End If
        i = i + 1
    End If
Next

Application.ScreenUpdating = True
End Sub

Answer 1

您可以使用正则表达式轻松完成此操作

Option Explicit

Sub TestExtract()
    Dim Arr As Variant
    Arr = ExtractNumbers(Worksheets("Sheet1").Range("A1:F10")) 'specify which range to analyze

    Debug.Print Join(Arr, "; ") 'just to visualize the array
End Sub

Public Function ExtractNumbers(Target As Range) As Variant
    Dim regEx As Object
    Set regEx = CreateObject("vbscript.regexp")

    Dim regExMatches As Object, regExMatch As Object
    Dim Result As String

    Dim Cell As Range
    For Each Cell In Target 'loop through each cell
        If Cell.Value <> vbNullString Then
            With regEx
                .Global = True
                .MultiLine = True
                .IgnoreCase = False
                .Pattern = "[0-9]+"
            End With

            'find all integers in each cell
            Set regExMatches = regEx.Execute(Cell.Value)
            For Each regExMatch In regExMatches
                Result = Result & regExMatch & ";"
            Next regExMatch
        End If
    Next Cell

    ExtractNumbers = Split(Left$(Result, Len(Result) - 1), ";") 'convert into array
    'sort array here if needed
End Function

请注意，我没有展示数组排序，因为已经有 100 万个教程。