求助按列拆分问题

jian82372387 · 发表于 2023-2-1 13:37

求助：附件分别以物流表的B列内容拆分成多个工作表的相应数据，再以F列内容拆分成多个工作表的相应数据，除了物流表外其他拆分出来的工作表以H列时间排序（升序扩展区域）,要将带相同仓库名字的B列和F列拆分出来的的数据放在同一个工作表里面，隔开一行，并加上标题，字体加粗，居中，外粗边框，  内部细边框。例：标橙色工作表A仓库的数据，请问有办法解决吗？？

下面是之前请教他人分别拆分的代码：（但是同一仓库的无法放再同一个工作表）
Sub 按列拆分()
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
a = Sheets("物流表").[a2].CurrentRegion
For i = 3 To UBound(a)
   key1 = Trim(a(i, 2)) & "出发"
   Key2 = Trim(a(i, 6)) & "下班"
   If Not d1.exists(key1) Then Set d1(key1) = CreateObject("Scripting.Dictionary")
   If Not d2.exists(Key2) Then Set d2(Key2) = CreateObject("Scripting.Dictionary")
   d1(key1)(i) = 1: d2(Key2)(i) = 1
Next

For Each Key In d1.keys
   If Evaluate("ISREF('" & Key & "'!A1)") = 0 Then Sheets.Add(After:=Sheets(Sheets.Count)).Name = Key
   With Sheets(Key)
      .[a1:k1] = [{"班号","车型","车牌号"，"开始单号","司机","副司机","学徒","上班时间","工号","打卡时间","出发地点"}]
      .[a3:n1000].ClearContents
      r = 2
      For Each Row In d1(Key)
         r = r + 1

         .Cells(r, 1) = Array(a(Row, 1))
         .Cells(r, 4) = Array("'" & a(Row, 4))
         .Cells(r, 8) = Array(a(Row, 3))
         .Cells(r, 11) = Array(a(Row, 2))
      Next
   End With
Next

For Each Key In d2.keys
   If Evaluate("ISREF('" & Key & "'!A1)") = 0 Then Sheets.Add(After:=Sheets(Sheets.Count)).Name = Key
   With Sheets(Key)
      .[a1:k1] = [{"班号","车型","车牌号"，"结束单号","司机","副司机","学徒","下班时间","工号","打卡时间","下班地点"}]
      .[a3:n1000].ClearContents
      r = 2
      For Each Row In d2(Key)
         r = r + 1

         .Cells(r, 1) = Array(a(Row, 1))
         .Cells(r, 4) = Array("'" & a(Row, 8))
         .Cells(r, 8) = Array(a(Row, 7))
         .Cells(r, 11) = Array(a(Row, 6))
      Next
   End With
Next

End Sub
   顺便请教一下上述代码红色那句的意思吗？

cutecpu · 发表于 2023-2-1 13:54

紅色那行是判斷該 sheet 在不在喔
不在的話就新增喔

jian82372387 · 发表于 2023-2-1 15:46

cutecpu 发表于 2023-2-1 13:54
紅色那行是判斷該 sheet 在不在喔
不在的話就新增喔

好的，感谢，请教一下有啥办法可以将B、H列拆分出来的放在一个工作表内啊？？？

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