如何提取单元格内多个数值 生成竖列数据求教函数公式或VBA代码！

diablosong

如何提取单元格内多个数值 生成竖列数据求教函数公式或VBA代码！

丸子不是小孩子

。。。。。。。。。。。。。。。。

liulang0808

Sub 按钮1_Click()
    r = Cells(Rows.Count, "x").End(3).Row
    arr = [v1].Resize(r * 10, 3)
    x = 1

    For j = 2 To r
        If InStr(arr(j, 3), "考场") > 0 And arr(j, 3) <> arr(j - 1, 3) Then
            brr = Split(Replace(arr(j, 3), "：", ":"), "考场")
            For i = 1 To UBound(brr)
                x = x + 1
                crr = Split(brr(i), ":")
                arr(x, 1) = Val(crr(0))
                arr(x, 2) = crr(1)
            Next i
        End If
    Next j
    [ad1].Resize(x, 3) = arr
End Sub

liulang0808

供参考。。。。。。

diablosong

丸子不是小孩子 发表于 2022-2-17 02:18
。。。。。。。。。。。。。。。。

在吗？？一直在使用你的代码 最近出现了下标越界 不知道哪里出了问题

diablosong

丸子不是小孩子 发表于 2022-2-17 02:18
。。。。。。。。。。。。。。。。

    Dim arr, brr(), i&, r&, z&, j&
    r = Range("x" & Rows.Count).End(xlUp).Row
    arr = [x2].Resize(r - 1)
    z = 0
    ReDim brr(1 To r - 1, 1 To 2)
    For i = 1 To r - 1
        ar = Split(arr(i, 1), "考场")
        i = i + UBound(ar) - 1
        For j = 1 To UBound(ar)
            z = z + 1
            ar(j) = Replace(Replace(ar(j), "：", ":"), Chr(10), "")
            brr(z, 1) = Val(Split(ar(j), ":")(0))
            brr(z, 2) = Trim(Split(ar(j), ":")(1))
        Next
    Next
    [v2].Resize(r - 1, 2) = brr
End Sub

chxw68

diablosong 发表于 2024-4-27 10:37
Dim arr, brr(), i&, r&, z&, j&
    r = Range("x" & Rows.Count).End(xlUp).Row
    arr = [x2]. ...

兼听则明，测试一下版主写的。