编号处理

sc204400

最近与SAP的编号杠上了，导出来的编号不同格式，现需要整理编号后导入另外一个系统中进才能匹配，以单格中首位存在空格为判断是否替换，如前面二个空格则以上一单元格的值+001为序号，以4-3的形式替换原单元格的值，如前面4个空格，则以4-3-3的形式替换原单元格的值并递增序号， 编号处理.rar (9.04 KB, 下载次数: 9)

2022-11-19 10:12 上传

点击文件名下载附件

，结果展示如C列，就是判断空格并替换有些绕

蓝桥玄霜

编号的例子：

捞屎人

有点小bug  自己改改吧

清风竹-

请看附件。

捞屎人

捞屎人 发表于 2022-11-19 11:18
有点小bug  自己改改吧

修复了一下

gwjkkkkk

Sub TEST()
    Dim arr, s$, R&
    arr = [a1].CurrentRegion
    For i = 2 To UBound(arr)
       If Len(Trim(Mid(arr(i, 1), 1, 4))) = 4 Then
            s = arr(i, 1)
            arr(i, 1) = s: R = 0
          ElseIf Len(Trim(Mid(arr(i, 1), 1, 4))) = 2 Then
            R = R + 1
            arr(i, 1) = s & "." & Format(R, "000")
            n = s & "." & Format(R, "000"): m = 0
       End If
        If Trim(Mid(arr(i, 1), 1, 6)) = "" Then
           m = m + 1
           arr(i, 1) = n & "." & Format(m, "000")
        End If
    Next i
    [D1].Resize(UBound(arr)).NumberFormatLocal = "@"
    [D1].Resize(UBound(arr)) = arr
End Sub

gwjkkkkk

代码审核中，请参考附件。。。

准提部林

Sub TEST_A1()
Dim Arr, i&, T$, X%, Y$(2), C%
Arr = Range(Sheet1.[a1], Sheet1.[a65536].End(3)(2))
For i = 2 To UBound(Arr) - 1
    X = Len(Arr(i, 1))
    If X = 4 Then Y(0) = Arr(i, 1): Y(1) = 0: Y(2) = 0: C = 4
    If X = 12 Then Y(1) = Format(Y(1) + 1, "000"): Y(2) = 0: C = 8
    If X = 16 Then Y(2) = Format(Y(2) + 1, "000"):  C = 12
    Arr(i - 1, 1) = Left(Join(Y, "."), C)
Next i
With [c2].Resize(UBound(Arr) - 2)
     .NumberFormatLocal = "@"
     .Value = Arr
End With
End Sub