返回列表 上一主題 發帖

[發問] ListBox與排序加總問題

本帖最後由 GBKEE 於 2016-10-28 05:22 編輯

回復 54# starbox520



圖表是工作表2上的資料,你要說清楚依據哪裡抓出來.


51#上說; 此圖的意思是,EX:上面的前五項資料 就是符合 "TR排機&產出" 第一行的資訊所篩選出來的
     相對的這些資料是從工作表2篩出來的,下面的資訊是工作表2排除那5筆剩下的資料,工作表2的數量已經從大至小排好了
     就由數量大到小呈現就可以了
  是排在工作表2上嗎

"TR排機&產出" 第一行的資訊 ,沒辦法抓圖示這前五項資料

49# 上PS:TR排機&產出模組 有修正,請修正你的檔案

修正後這段程式碼是正確的
  1. If .Cells(i, "A") = A(1) And .Cells(i, "E") = A(2) And .Cells(i, "G") = A(3) And .Cells(i, "F") = A(4) Then
複製代碼
無須改成
  1. If .Cells(i, "A") = A(1) And .Cells(i, "E") = A(2) And .Cells(i, "G") = A(3) And CStr(.Cells(i, "F")) = A(4) Then
複製代碼
第2個LIstBox可以改成這9攔嗎   ( T/Y改成customer)     時間的資料大大您取到B欄"Queue Time"應該是P欄"Oven OutTime"
       Customer       Location       Device     Package      BodySize     LC        QTY        Schedule       Oven OutTime
這裡修改試試看
  1. Private Sub Ex_WIP()
  2. Dim i As Integer, Ar, A(1 To 4), Ab(), ii As Integer
  3. With Me.lstSelector
  4. For i = 0 To 3
  5. A(i + 1) = .List(.ListIndex, i)
  6. Next
  7. End With
  8. i = 2
  9. With Sheets("WIP")
  10. Do While .Cells(i, 1) <> ""
  11. If .Cells(i, "A") = A(1) And .Cells(i, "E") = A(2) And .Cells(i, "G") = A(3) And .Cells(i, "F") = A(4) Then
  12. If IsEmpty(Ar) Then ReDim Ar(1 To 1) Else ReDim Preserve Ar(1 To UBound(Ar) + 1)
  13. '** 要重排欄位請改這裡 ** Customer Location Device Package 'BodySize
  14. Ar(UBound(Ar)) = Array(.Cells(i, "A").Text, .Cells(i, "C").Text, .Cells(i, "D").Text, .Cells(i, "E").Text, _
  15. .Cells(i, "G").Text, .Cells(i, "F").Text, .Cells(i, "K").Text, .Cells(i, "I").Text, .Cells(i, "P").Text)
  16. '** BodySize LC QTY Schedule Oven OutTime
  17. '** Listbox 最多顯示 9列
  18. End If
  19. i = i + 1
  20. Loop
  21. End With
  22. '***********************************
  23. '**frmSelector中的第二個ListBox 控制項
  24. With ListBox1
  25. .Clear
  26. If UBound(Ar) > 1 Then
  27. .List = Application.Transpose(Application.Transpose(Ar))
  28. ElseIf UBound(Ar) = 1 Then
  29. .List = Ar(1)
  30. End If
  31. End With
  32. '***********************************
  33. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 57# starbox520
再把結果接著放在     第一個ListBox"第一步"做好的資訊下接著呈現  (下方資訊應不該再出現"第一步"的資訊)
修改這裡
  1. Private Sub Ex_Customer_Package()
  2.     Dim i As Integer, ii As Integer, Ar, xRng As Range, xi As Integer
  3.     Sh_Ar = "":   i = 2
  4.     With Sheets("工作表2")
  5.         '只是要把工作表2在"第一步"篩完剩下的資訊 以Package.BodySize相同,數量由大致小做排列 ** 要先做排序
  6.         .UsedRange.Sort Key1:=.Cells(1, "H"), Order1:=2, Key2:=.Cells(1, "B"), Order2:=1, Key3:=.Cells(1, "B"), Order3:=1, Header:=True
  7.         '******************************************************************************
  8.         Do While .Cells(i, 1) <> ""
  9.             If .Cells(i, 1) = Sh_Rng And .Cells(i, 2) = Sh_Rng(1, 2) Then
  10.                 xi = xi + 1
  11.                 If xRng Is Nothing Then
  12.                     Set xRng = .Cells(i, 1).Resize(, 8)
  13.                 Else
  14.                     Set xRng = Union(.Cells(i, 1).Resize(, 8), xRng)
  15.                 End If
  16.               End If
  17.             i = i + 1
  18.         Loop
  19.         If xRng Is Nothing Then Exit Sub
  20.         .Range("A2").Resize(xi).EntireRow.Insert
  21.         xRng.Copy .Range("A2")
  22.         xRng.EntireRow.Delete
  23.          Sh_Ar = .Range("A2", .Range("A2").End(xlDown)).Resize(, 4)  ' Resize(, 4) 'A欄-D欄  ' Resize(, 8) 'A欄-H欄
  24.     End With
  25. End Sub
複製代碼
請問為什麼顯示一筆資料的時候會這樣呢
修改 Private Sub Ex_WIP()
  1. '***********************************
  2.     '**frmSelector中的第二個ListBox 控制項
  3.     With ListBox1
  4.         .Clear
  5.         If UBound(Ar) > 1 Then
  6.              .List = Application.Transpose(Application.Transpose(Ar))
  7.         ElseIf UBound(Ar) = 1 Then
  8.             ReDim AB(0, 8)
  9.             For i = 0 To 8
  10.                 AB(0, i) = Ar(1)(i)
  11.             Next
  12.            .List = AB
  13.         End If
  14.     End With
  15.     '***********************************
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 62# starbox520
55# 上我有說
49# 上PS:TR排機&產出模組 有修正,請修正你的檔案
  1. '  Ar(UBound(Ar)) = .Cells(i, 1).Resize(, 4) 修改
  2. Ar(UBound(Ar)) = .Cells(i, 1).Resize(, 8)
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 68# starbox520
  1.   If .Cells(i, 2) = Sh_Rng And .Cells(i, 3) = Sh_Rng(1, 2) Then
複製代碼
改Target(1).Column = 5 為 Target(1).Column = 6
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2.     If IsError(Target(1)) Then Unload frmSelector:         Exit Sub
  3.     If (Target(1).Row + 1) Mod 5 = 0 And Target(1) <> "" And Target(1).Column = 5 Then
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 70# starbox520
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)   
  2.     If IsError(Target(1)) Then Unload frmSelector:         Exit Sub
  3. '    If (Target(1).Row + 1) Mod 5 = 0 And Target(1) <> "" And Target(1).Column = 5 Then
  4.      If (Target(1).Row + 1) Mod 5 = 0 And Target(1) <> "" And Target(1).Column = 6 Then
  5.         'Set Sh_Rng = Cells(Target(1).Row, "E")
  6.         Set Sh_Rng = Cells(Target(1).Row, "F")  '**這裡也要改
  7.         Ex_Customer_Package
  8.         
  9.         If IsEmpty(Sh_Ar) Then MsgBox Sh_Rng & "-" & Sh_Rng(1, 2) & vbLf & "找不到": Exit Sub
  10.         Unload frmSelector
  11.         frmSelector.Show False
  12.     Else
  13.         Unload frmSelector
  14.     End If
  15. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 【行善要及時】行善要及時,功德要持續。如燒開水一般,未燒開之前千萬不要停熄火候,否則重來就太費事了。
返回列表 上一主題