批量形成资产标签

漫不经心14

公司资产有几万件资产，想使用快捷的方式批量生成固定资产标签，使用了网友们分享的教程和模板，
因标签模板不同，本人对VBA编程一窍不通，折腾了好久都没弄出来
资产明细表有多少条数据，就能生成多少个标签，标签模板要求如下
求各位大神相助，感激不尽！

zpy2

是这种情况吗？

liushi130

标签是另存为到文件夹下，做新的EXCEL文件，还是直接新建sheet表格啊？

liulang0808

此类问题，论坛案例比较多的，楼主也可以搜一下其他的案例
如果还有其他问题，建议将楼主需求的模板制作好，并结合说明

liushi130

每个标签另存为excel了，要是有别的需求可以用录制宏的办法改一下。我也是刚学不久，代码速度可能不太快。
Sub 卡片()
Dim arr
Dim i, name, mypath
Application.ScreenUpdating = False
mypath = ActiveWorkbook.Path

arr = Sheets("资产明细").Range("a1").CurrentRegion

For i = 2 To UBound(arr)
    name = Application.WorksheetFunction.Text(arr(i, 1), "0000000000") & arr(i, 2)
    With Sheets("标签模板")
        Range("B2") = Application.WorksheetFunction.Text(arr(i, 1), "'0000000000")
        Range("D2") = arr(i, 2)
        Range("B3") = arr(i, 3)
        Range("B4") = arr(i, 5)
        Range("D4") = arr(i, 4)
        Range("B5") = arr(i, 6)
        Range("D5") = arr(i, 7)
    End With
    Sheets("标签模板").Copy
    ActiveWorkbook.SaveAs Filename:=mypath & "\" & name & ".xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
Next i

Application.ScreenUpdating = True
End Sub

3190496160

Sub 标签()
Application.ScreenUpdating = False
Dim ar As Variant
With Sheets("资产明细")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    If r < 2 Then MsgBox "资产明细为空！": End
    ar = .Range("a1:g" & r)
End With
gs = r - 1
With Sheets("标签模板")
    rs = .Cells(Rows.Count, 1).End(xlUp).Row
    If rs > 6 Then .Rows("7:" & rs).Delete
    Range("B2,D2,B3:D3,B4,D4,B5,D5") = Empty
    m = 7
    For i = 2 To gs
        .Rows("1:6").Copy .Cells(m, 1)
        m = m + 6
    Next i
    m = 2
    For i = 2 To UBound(ar)
        If Trim(ar(i, 1)) <> "" Then
            .Cells(m, 2) = ar(i, 1)
            .Cells(m, 4) = ar(i, 2)
            .Cells(m + 1, 2) = ar(i, 3)
            .Cells(m + 2, 2) = ar(i, 5)
            .Cells(m + 2, 4) = ar(i, 4)
            .Cells(m + 3, 2) = ar(i, 6)
            .Cells(m + 3, 4) = ar(i, 7)
            m = m + 6
        End If
    Next i
    .Select
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

3190496160

一键生成固定资产标签.rar (22.74 KB, 下载次数: 48)

2023-2-7 09:34 上传

点击文件名下载附件

3190496160

代码仅供参考，因为，很多细节为描述清楚，比如：
1、生成的标签与标签之间需不需要空一行？
2、每行是一个标签，还是两个标签？
2、是需要生成一个独立的工作薄文件，还是？？

漫不经心14

3190496160 发表于 2023-2-7 09:37
代码仅供参考，因为，很多细节为描述清楚，比如：
1、生成的标签与标签之间需不需要空一行？
2、每行是一 ...

非常感谢你的热心帮助
根据你提供的代码批量制作了4千多条标签，运行时很顺畅。
生成后的标签样式正是我想要的。
另外还出现有2个小问题：一是资产编号为10位数，但生成标签后前面的几个 0 没有了；二是运行后启用日期错乱，原表中的日期也被篡改了。
希望你可以帮忙解决一下