求助贴,请EH家人帮忙修改一下标签代码

q490525427 · 发表于 2024-2-22 22:19

本帖最后由 q490525427 于 2024-2-23 17:15 编辑

EH家人大家好,帮忙修改下这个标签代码
以I列档口为单位,同一家数据全部添加进去
货单表向下设置搜索一千行吧
表的格式这样就好,一个标签直接格一行

现在是数据添加不全,AI代写的,搞不定,麻烦大家了,龙年大吉.

liulang0808版主已解决
代码附件6-7楼
https://club.excelhome.net/forum ... 685215&pid=11439356
谢版主,谢大家

ykcbf1100 · 发表于 2024-2-23 07:23

货单和提货单，这二个表的相互关系没看出来。提货单只有一个数据，到了货单中就变成了3个，怎么来的？

shiruiqiang · 发表于 2024-2-23 07:35

ykcbf1100 发表于 2024-2-23 07:23
货单和提货单，这二个表的相互关系没看出来。提货单只有一个数据，到了货单中就变成了3个，怎么来的？

数据乱模拟的呗

ykcbf1100 · 发表于 2024-2-23 07:45

shiruiqiang 发表于 2024-2-23 07:35
数据乱模拟的呗

主要楼主没给出数据提取规则。

shiruiqiang · 发表于 2024-2-23 07:48

ykcbf1100 发表于 2024-2-23 07:45
主要楼主没给出数据提取规则。

我觉得他要做3级字典嵌套：档口--货号、颜色--尺寸。然后多一空行

liulang0808 · 发表于 2024-2-23 07:52

Sub GenerateLabelsByShopNameWithTitleAndSpacing()
Set d = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
arr = Sheets(1).[a1].CurrentRegion
Set Rng = Sheets(1).[a1:i1]
ReDim brr(1 To UBound(arr, 2))
For j = 2 To UBound(arr)
      If Not d.exists(arr(j, 9)) Then
         Set d(arr(j, 9)) = CreateObject("scripting.dictionary")
      End If
      str1 = arr(j, 1) & "##" & arr(j, 2)
      If Not d(arr(j, 9)).exists(str1) Then
         For i = 1 To UBound(arr, 2)
            brr(i) = arr(j, i)
         Next i
         d(arr(j, 9))(str1) = brr
      Else
         crr = d(arr(j, 9))(str1)
         For i = 3 To UBound(arr, 2) - 1
            crr(i) = Val(arr(j, i)) + Val(crr(i))
         Next i
      End If
Next j
Sheets("我的提货单").Select
Sheets("我的提货单").UsedRange.ClearContents
r = 0
For Each k In d.keys
      r = r + 1
      Rng.Copy Cells(r, 1)
      For Each kk In d(k).keys
         crr = d(k)(kk)
         r = r + 1
         Cells(r, 1).Resize(1, UBound(crr)) = crr
      Next kk
      r = r + 1
Next k
Application.ScreenUpdating = True
End Sub

liulang0808 · 发表于 2024-2-23 07:55

修改标签代码.zip (19.01 KB, 下载次数: 6)
因为系统原因看不到图片，所以猜了一下

fzxba · 发表于 2024-2-23 08:18

Sub test0()
Dim ar, br(), s As String
Dim i As Long, j As Long, k As Long, r As Long
With Sheet1
ar = .Range("A1", .Cells(.Rows.Count, "I").End(xlUp).Offset(1)).Value
End With
ReDim br(1 To UBound(ar) * 4, 1 To UBound(ar, 2))
For i = 2 To UBound(ar) - 1
If ar(i, UBound(ar, 2)) <> s Then
s = ar(i, UBound(ar, 2))
r = r + 2
For j = 1 To UBound(ar, 2)
br(r - 1, j) = ar(1, j)
Next
For j = 1 To UBound(ar, 2)
br(r, j) = ar(i, j)
Next
Else
k = k + 1
End If
If ar(i + 1, UBound(ar, 2)) <> ar(i, UBound(ar, 2)) Then
r = r + 1
If k > 1 Then
For j = 1 To UBound(ar, 2)
br(r, j) = ar(i, j)
Next
End If
r = r + 1
k = 0
End If
Next
With Sheet2
.UsedRange.ClearContents
With .Range("A1").Resize(r - 1, UBound(br, 2))
.Columns(1).NumberFormatLocal = "@"
.Value = br
End With
End With
Beep
End Sub

复制代码

fzxba · 发表于 2024-2-23 08:20

本帖最后由 fzxba 于 2024-2-23 08:59 编辑

改一句位置修改标签代码.rar (22.77 KB, 下载次数: 5)

q490525427 · 发表于 2024-2-23 13:46

ykcbf1100 发表于 2024-2-23 07:23
货单和提货单，这二个表的相互关系没看出来。提货单只有一个数据，到了货单中就变成了3个，怎么来的？

是货单转提货单,开始忘记说明了,现已解决,感谢回帖

		自动登录	找回密码
密码			免费注册

[已解决] 求助贴,请EH家人帮忙修改一下标签代码

评分

评分