批量拆分数量生成+1序列号

YANWEI82123300

请老师看看如何使用VBA进行批量拆分数量并依据A列值生成序列号，谢谢
下面的例子和附件
WO 数量 SN
20233097 5
20233098 7
WO      数量      SN
20233097 1 20233097-001
20233097 1 20233097-002
20233097 1 20233097-003
20233097 1 20233097-004
20233097 1 20233097-005
20233098 1 20233098-001
20233098 1 20233098-002
20233098 1 20233098-003
20233098 1 20233098-004
20233098 1 20233098-005
20233098 1 20233098-006
20233098 1 20233098-007

papshaw

何需vba，power query即可。

liulang0808

Sub 按钮2_Click()
    Dim brr()
    arr = [a1].CurrentRegion
    x = WorksheetFunction.Sum(Columns(2))
    ReDim brr(1 To x, 1 To 3)
    r = 0
    For j = 2 To UBound(arr)
        For i = 1 To arr(j, 2)
            r = r + 1
            brr(r, 1) = arr(j, 1)
            brr(r, 2) = 1
            brr(r, 3) = arr(j, 1) & "-" & Format(i, "000")
        Next i
    Next j
    Sheets(2).[a2].Resize(r, 3) = brr
End Sub

liulang0808

附件内容供参考。。。。。。

mmx1122

1. Private Sub CommandButton2_Click() '拆分多数量的产品编号
   
2. Dim n, cpcount As Integer
   
3. 
   
4.     For i = ActiveSheet.Range("A65536").End(xlUp).Row To 2 Step -1      '从最后一行到第2行循环，每次减1行
   
5.         n = Cells(i, 2)                                                 '获取数量
   
6.         If n = 1 Or n = 0 Then                                          '如果数量等于1或0则跳过，并向下循环
   
7.             On Error GoTo 100
   
8.         Else
   
9.             Rows(i + 1 & ":" & i + n - 1).Select
   
10.             Selection.Insert Shift:=xlDown                              '在这款后插入相应数量的行
    
11.             
    
12.             For j = i + 1 To i + n - 1
    
13.                 Cells(j, 1) = Cells(i, 1)
    
14.                 Cells(j, 2) = 1
    
15.                 Cells(i, 2) = 1
    
16.             Next j
    
17.                         
    
18.             cpcount = Application.CountIf(ActiveSheet.Range("A:A"), Cells(i, 1))
    
19.             For k = 1 To cpcount    '加了一个序列号
    
20.                 Cells(i, 3) = Cells(i, 1) & "-" & Format(k, "000")
    
21.                 i = i + 1
    
22.             Next k
    
23.         End If
    
24. 100:
    
25.     Next i
    
26.     Cells(1, 1).Select
    
27. End Sub

复制代码

Yalishanda30

附件供参考

YANWEI82123300

感谢大家的帮助！！

YANWEI82123300

liulang0808 发表于 2019-12-17 13:14
Sub 按钮2_Click()
    Dim brr()
    arr = [a1].CurrentRegion

谢谢我已经解决了

YANWEI82123300

liulang0808 老师您看看我增加了一些字段并且要拆分的字段的位置变化了，但是出不来结果，您给看看，谢谢
下面的代码是照猫画虎做的，有问题不出结果
Sub ExtactWO_Click()
    Dim brr()
    Dim j As Integer
    arr = [d1].CurrentRegion '把[D1始的当前区域的值赋给（或者叫装入）数组。CurrentRegion当前区域，其返回的为区域即Range,Range的默认属性为Value,Arr为数组，此句应是简写，全部应该是Arr = [a1].CurrentRegion.value
    x = WorksheetFunction.Sum(Columns(3))
    ReDim brr(1 To x, 1 To 4) '重新定义数组brr,调整第一维下标从1起到x止,第二维下标从1起到4止.
    r = 0
    For j = 2 To UBound(arr) '是j2开始到数组的最大下标
        For i = 1 To arr(j, 3) '取一维数组第一行第三列值
            r = r + 1
                brr(r, 1) = arr(j, 1) '第二列值
            brr(r, 2) = 1 '第二列值
            brr(r, 4) = arr(j, 1) & "-" & Format(i, "000") '第三列值
        Next i
    Next j
    Sheets(3).[a2].Resize(r, 4) = brr
End Sub

liulang0808

附件内容供参考