宏开发:excel中添加拼接行

Sub 万途标签()
Dim i
For i = 1 To Sheets.Count
    If Sheets(i).Name = "数据表" Then
        If MsgBox("数据表已经存在,是否删除?", vbOKCancel) = vbOK Then
        Sheets(i).Delete
        Else
       
     MsgBox "条码生成操作已经取消."
     Exit Sub
        End If
    End If
Next


Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "数据表"

Dim a, b
a = Application.WorksheetFunction.CountA(Worksheets("sheet").Columns("a"))
b = 2
Do While b <= a
If Trim(Worksheets("sheet").Columns("a").Rows(b).Value) <> "" Then
Dim c
c = 1
Do While c <= CInt(Worksheets("sheet").Columns("a").Rows(b).Value)
Worksheets("数据表").Columns("a").Rows(CInt(Application.WorksheetFunction.CountA(Worksheets("数据表").Columns("a"))) + 1).Value = CStr((Worksheets("sheet").Columns("b").Rows(b).Value) & (Application.WorksheetFunction.Rept(0, 3 - Len(CStr(c)))) & (CStr(c)))
 
c = c + 1
 
Loop
 
End If
 
 
b = b + 1
Loop
 
 Worksheets("数据表").Columns("a").NumberFormat = "0"
 
 MsgBox "共生成" & Application.WorksheetFunction.CountA(Sheets("数据表").Columns("a")) & "条编码"
 

End Sub

转载于:https://www.cnblogs.com/iframe/p/7743149.html