有若干个起止号段，求助用VBA展开成单卡号形式

liuqiang_75

这些卡号像这样的长字符串，有起始卡号，有个数。将帮忙用VBA在卡号个数旁边列展开成单卡，第1行的整理完毕后，第2行的接着后面继续这样。多谢

无关岁月

Sub 按钮1_Click()
Dim arr, i, j, m
arr = [f1].CurrentRegion.Resize(, 3)
ReDim brr(1 To 10 ^ 4, 1 To 1)
For i = 2 To UBound(arr)
    For j = 1 To arr(i, 3)
        m = m + 1
        brr(m, 1) = Left(arr(i, 1), Len(arr(i, 1)) - 4) & Val(Right(arr(i, 1), 4)) + j - 1
    Next
Next
[i2:i10000].NumberFormatLocal = "@"
[i2].Resize(UBound(brr)) = brr
End Sub

liuqiang_75

无关岁月 发表于 2024-8-8 21:05
Sub 按钮1_Click()
Dim arr, i, j, m
arr = [f1].CurrentRegion.Resize(, 3)

测试有效，多谢

quqiyuan

参与一下。。。

quqiyuan

代码如下。。。
Sub test()
    arr = [h1].CurrentRegion
    ReDim brr(1 To 100000, 1 To 1)
    For i = 2 To UBound(arr)
        x = Len(arr(i, 3))
        For j = 0 To arr(i, 3) - 1
            n = n + 1
            s = arr(i, 1)
            brr(n, 1) = "'" & Left(s, Len(s) - x - 1) & (Right(s, x+1) + j)
        Next
    Next
    [j2].Resize(n) = brr
    Beep
End Sub

liuqiang_75

quqiyuan 发表于 2024-8-8 22:02
代码如下。。。
Sub test()
    arr = [h1].CurrentRegion

收到，多谢

liuqiang_75

quqiyuan 发表于 2024-8-8 22:01
参与一下。。。

收到，多谢

liuqiang_75

liuqiang_75 发表于 2024-8-8 21:37
测试有效，多谢

javascript:;

liuqiang_75

无关岁月 发表于 2024-8-8 21:05
Sub 按钮1_Click()
Dim arr, i, j, m
arr = [f1].CurrentRegion.Resize(, 3)

这个当遇到10万条以上时，补0这个规则就多了一位，请帮忙看看

无关岁月

liuqiang_75 发表于 2024-8-9 18:04
这个当遇到10万条以上时，补0这个规则就多了一位，请帮忙看看

略微修改一下