Excel根据条件将一行数据拆分成多行数据

zhmalbert

gwjkkkkk 发表于 2023-4-13 19:59
参与一下。。。

非常感谢，各位大佬都非常热心

chengyunpan

楼主的需求，我估计是为了整理数据用于批量打印。在此我就用我开发的万能批量打印软件为楼主做一个示范案例。类似邮件合并那种数据照般的批量打印软件，很多时候需要先处理大量的数据，也是很麻烦。我的批量软件是万能套用的，具有数据处理能力，能把打印数据最简化，再复杂的批量打印，也能用我软简单实现。这里只是个示例，可以按各种需求设计。




软件简介：   
     真正的软件级别，VBA通用软件，用于批量打印、拆分，用于特殊需求的录入、打印等等。不需改代码，就可以万能套用。复杂的数据引用、格式要求都能简单解决。
      单个、少量、批量操作（打印、拆分等）或者选择性操作都一样方便。
      核心很简单，就是用“=”号引用对应数据列，并作简单设置，一学就会，很容易套用到工作中遇到的实际案例。
       界面超级简单，千篇一律，傻瓜式操作。
      每个案例都仅是此软件的一个小应用，学会一个案例作参考就能一里通百里用，欢迎大家测试使用，更期待能提出宝贵意见。
     软件免费，并附简易教程，需要做简单设计才能吻合到实际案例。也可以联系作者提供设计服务，能为你提供完美的整体解决方案。
      文件就是软件！！！

zhmalbert

各位大佬，能不能根据数据拆分的结果，将表中sheet2的数据，按照表中打印模板，直接打印出来（模板中包含二维码），每页打6条数据，因为数据量比较 多，希望通过VB来实施，谢谢

chengyunpan

zhmalbert 发表于 2023-4-13 23:22
各位大佬，能不能根据数据拆分的结果，将表中sheet2的数据，按照表中打印模板，直接打印出来（模板中包含二 ...

我上面的案例就预测了你的需求，

chengyunpan

zhmalbert 发表于 2023-4-13 23:22
各位大佬，能不能根据数据拆分的结果，将表中sheet2的数据，按照表中打印模板，直接打印出来（模板中包含二 ...

不需要你处理数据，就能直接批量打印

jjmysjg

留下记号，谢谢

zhmalbert

chxw68 发表于 2023-4-13 19:02
修改好了。

大神 ，非常感谢你之前的帮忙，现在有点小问题，能帮我把拆分后的数据加个序号吗?不用分组，就是拆分成多少条，就生成到 多少的序号，麻烦了，谢谢

ykcbf1100

zhmalbert 发表于 2024-8-28 23:46
大神 ，非常感谢你之前的帮忙，现在有点小问题，能帮我把拆分后的数据加个序号吗?不用分组，就是拆分成多 ...

结果表加入序号，原数据在订单数量列前面插入列也不用改代码了。
结果放在表２

ykcbf1100

参与一下。。。

1. Sub ykcbf()    '//2024.8.29
   
2.     Application.ScreenUpdating = False
   
3.     With Sheets("Sheet1")
   
4.         r = .Cells(Rows.Count, 1).End(3).Row
   
5.         c = .Cells(1, "XFD").End(1).Column
   
6.         c1 = .Rows(1).Find("订单数量", LookIn:=xlValues).Column
   
7.         arr = .[a1].Resize(r, c)
   
8.         ReDim brr(1 To 10000, 1 To c + 4)
   
9.         For i = 2 To UBound(arr)
   
10.             n = arr(i, c1) \ arr(i, c1 + 1)
    
11.             If n * arr(i, c1 + 1) = arr(i, c1) Then n = n Else n = n + 1
    
12.             For x = 1 To n
    
13.                 m = m + 1
    
14.                 brr(m, 1) = m
    
15.                 For j = 1 To UBound(arr, 2)
    
16.                     brr(m, j + 1) = arr(i, j)
    
17.                 Next
    
18.                 If x < n Then brr(m, c + 2) = arr(i, c1 + 1) Else brr(m, c + 2) = arr(i, c1) - (n - 1) * arr(i, c1 + 1)
    
19.                 brr(m, c + 3) = x
    
20.                 brr(m, c + 4) = n
    
21.             Next
    
22.         Next
    
23.     End With
    
24.     With Sheets("Sheet2")
    
25.         .UsedRange.Offset(1).Clear
    
26.         .[a2].Resize(m, c + 4) = brr
    
27.         .[a2].Resize(m, c + 4).Borders.LineStyle = 1
    
28.     End With
    
29.     Application.ScreenUpdating = True
    
30.     MsgBox "OK！"
    
31. End Sub
    
32. 
    

复制代码

zhmalbert

ykcbf1100 发表于 2024-8-29 07:30
参与一下。。。

非常感谢，解决了大问题