字典学习 输出表格

cqjinxin

wang-way 发表于 2024-6-25 10:40
你自己想想 这样分行的依据是什么    是不是有点问题 ？

就是  同一日累计往下填写，然后左侧补上最长单元格船号  填完后 再填下一个船号

cqjinxin

wang-way 发表于 2024-6-25 10:41
同一个日期  第二次出现就算再第二行 ？

是的  这个点处理起来我感觉是个难点 所以用字典的方法感觉遇到的阻碍

wang-way

cqjinxin 发表于 2024-6-25 10:42
是的  这个点处理起来我感觉是个难点 所以用字典的方法感觉遇到的阻碍

也就是 船号一开始不知道要填多少行。要结合同一个日期 内容填写多少次来判断

ykcbf1100

附件供参考，结果在表2

代码更新一下吧。

ykcbf1100

改一句代码就可以了。

1. Sub ykcbf()   '//2024.6.25
   
2.     Dim arr, brr, d
   
3.     Application.ScreenUpdating = False
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     arr = Sheets("Sheet1").Range("a1").CurrentRegion
   
6.     ReDim brr(1 To UBound(arr), 1 To 100)
   
7.     For i = 2 To UBound(arr)
   
8.         s = arr(i, 1)
   
9.         If Not d.Exists(s) Then
   
10.             m = m + 1
    
11.             d(s) = m
    
12.             brr(m, 1) = m
    
13.             brr(m, 2) = arr(i, 1)
    
14.         End If
    
15.         r = d(arr(i, 1))
    
16.         n = 2 + Day(arr(i, 3))
    
17.         brr(r, n) = IIf(InStr(brr(r, n), arr(i, 2)), brr(r, n), brr(r, n) & IIf(brr(r, n) = "", "", "、") & arr(i, 2))
    
18.     Next
    
19.     With Sheets("Sheet2")
    
20.         .UsedRange.Offset(7).Clear
    
21.         With .[a8].Resize(m, 33)
    
22.             .Value = brr
    
23.             .Borders.LineStyle = 1
    
24.             .HorizontalAlignment = xlCenter
    
25.             .VerticalAlignment = xlCenter
    
26.         End With
    
27.     End With
    
28.     Set d = Nothing
    
29.     Application.ScreenUpdating = True
    
30.     MsgBox "OK！"
    
31. End Sub
    

复制代码

wang-way

ykcbf1100 发表于 2024-6-25 10:54
附件供参考，结果在表2

大师  不是这个要求

grf1973

把同一船号、同一日期的写在一个单元格里？

cqjinxin

wang-way 发表于 2024-6-25 10:41
同一个日期  第二次出现就算再第二行 ？

是的  难点就在这里 累计往下填写的

cqjinxin

wang-way 发表于 2024-6-25 10:54
也就是 船号一开始不知道要填多少行。要结合同一个日期 内容填写多少次来判断

对的 这个理解很正确 确实这个我也很头疼  要找到填写最多的行来判断竖向生成多少行船号

ykcbf1100

wang-way 发表于 2024-6-25 10:56
大师  不是这个要求

不是这样啊？按他的效果图应该就这样啊。