Excel VBA代码调试：板材贴纸生成程序数据填充失败问题排查

嘿，我帮你找出了几个导致数据填充部分失效的核心问题，咱们逐个解决：

1. 变量名踩了VBA关键字的坑 #

你用row作为循环变量，但row是VBA的内置关键字（比如用来表示单元格行号的Range.Row），这会让编译器搞混逻辑，把变量名改成dataRow这种自定义名称就能解决。

2. 循环终止条件逻辑错误 #

原代码里的Do Until stickergemaakt > stickeraantal会多生成一张贴纸：比如要做3张，stickergemaakt从0开始，会跑到4才停止。改成Do Until stickergemaakt >= stickeraantal，生成到指定数量就停，刚好符合需求。

3. Range对象赋值漏了Set关键字 #

切换贴纸行的代码里：

sticker = sticker.Offset(1, -6)

sticker是Range对象，赋值必须用Set，不然会把单元格的值塞给变量，而不是让它指向新的单元格。另外，你设置了偶数行是间隔行（行高5.25），奇数行才是贴纸行，所以要跳2行而非1行，正确写法是：

Set sticker = sticker.Offset(2, -6)

4. aantalrng范围可能越界 #

原代码用aantal.End(xlDown)取范围，如果aantal下面有空单元格，会直接跳到工作表最后一行，导致循环处理大量空行。我加了逻辑检查下一个"Code"表头的位置，确保aantalrng只包含当前板材的数据，不会跨到其他板材的范围。

5. 贴纸内容的列偏移可能指向错误 #

原代码里获取Label用了Offset(0, -3)，但aantalrng是列D的范围，-3会跳到列A，你得根据自己的实际数据结构调整这个偏移值，比如如果Label在列B，就改成Offset(0, -2)。

修正后的完整代码 #

Sub Platen_stickers()
    Application.ScreenUpdating = False
    Dim i As Long
    Dim xLast As Long
    Dim rw As Range
    Dim aantalrng As Range
    Dim aantal As Range
    Dim plaattype As Range
    Dim Merk As String, Label As String, Lengte As String, Breedte As String
    Dim stickeraantal As Byte, stickergemaakt As Byte
    Dim sticker As Range
    Dim dataRow As Range ' 替换row关键字，避免冲突
    Dim x As Long
    Dim lastDataRow As Long ' 存储当前板材数据的最后一行
    Dim nextHeaderRow As Long ' 存储下一个"Code"表头的位置
    
    On Error Resume Next
    xLast = ActiveWorkbook.Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row ' 获取B列最后一行
    
    For i = 8 To xLast Step 1
        If Sheets(1).Cells(i, "B").Value2 = "Code" Then ' 定位"Code"表头
            Set plaattype = Sheets(1).Cells(i + 1, "B") ' 当前板材类型
            Set aantal = plaattype.Offset(0, 2) ' 对应D列的数量起始单元格
            
            ' 确定当前板材数据的最后一行，避免越界
            lastDataRow = Sheets(1).Cells(aantal.Row, "D").End(xlDown).Row
            ' 查找下一个"Code"表头，限定数据范围
            nextHeaderRow = Sheets(1).Cells(aantal.Row, "B").Find(What:="Code", After:=aantal, LookIn:=xlValues).Row
            If Not nextHeaderRow = 0 And nextHeaderRow < lastDataRow Then
                lastDataRow = nextHeaderRow - 2
            End If
            Set aantalrng = Sheets(1).Range(aantal, Sheets(1).Cells(lastDataRow, "D"))
            
            ' 新建贴纸工作表
            ActiveWorkbook.Sheets.Add After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)
            ActiveSheet.Name = plaattype.Value2
            Set sticker = ActiveSheet.Range("A1") ' 初始贴纸位置
            
            ' 设置贴纸区域格式
            With ActiveSheet.Range("A1:F31")
                .Columns("A:F").ColumnWidth = 18.14
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
            
            ' 设置行高：奇数行是贴纸行，偶数行是间隔行
            For Each rw In ActiveSheet.Range("A1:F32").Rows
                rw.RowHeight = IIf(rw.Row Mod 2 = 0, 5.25, 53.25)
            Next rw
            
            ' 设置打印参数
            With ActiveSheet.PageSetup
                .CenterHorizontally = True
                .CenterVertically = True
                .LeftMargin = Application.CentimetersToPoints(0)
                .RightMargin = Application.CentimetersToPoints(0)
                .TopMargin = Application.CentimetersToPoints(0.6)
                .BottomMargin = Application.CentimetersToPoints(0.6)
                .HeaderMargin = Application.CentimetersToPoints(1.3)
                .FooterMargin = Application.CentimetersToPoints(1.3)
                .Zoom = 87
            End With
            
            x = 1 ' 列计数器初始化
            ' 生成贴纸
            For Each dataRow In aantalrng
                stickergemaakt = 0
                stickeraantal = dataRow.Value
                
                ' 跳过空值或0的行，避免生成空贴纸
                If stickeraantal = 0 Then GoTo SkipRow
                
                Do Until stickergemaakt >= stickeraantal
                    ' 请根据实际数据列调整Offset值！
                    Merk = dataRow.Offset(0, -1).Value ' 列C
                    Label = dataRow.Offset(0, -2).Value ' 列B（原代码是-3，按需调整）
                    Lengte = dataRow.Offset(0, 1).Value ' 列E
                    Breedte = dataRow.Offset(0, 2).Value ' 列F
                    
                    ' 写入贴纸内容
                    sticker.Value = Merk & " " & Label & vbCrLf & Lengte & " x " & Breedte & " mm" & vbCrLf & plaattype.Value2
                    
                    ' 切换到下一个贴纸位置
                    If x < 6 Then
                        Set sticker = sticker.Offset(0, 1)
                        x = x + 1
                    Else
                        Set sticker = sticker.Offset(2, -6) ' 跳2行跳过间隔行
                        x = 1
                    End If
                    
                    stickergemaakt = stickergemaakt + 1
                Loop
SkipRow:
                stickeraantal = 0
            Next dataRow
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

最后提醒 #

• 一定要根据你的实际数据列调整Merk、Label等变量的Offset值，不然会取不到正确的数据。
• 代码里加了跳过空值/0数量行的逻辑，避免生成无用的空贴纸。

内容的提问来源于stack exchange，提问作者Tom_DK