宏开发: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