12345678
返回列表 上一主題 發帖

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

starbox520

帖子
192 
主題
15 
精華
0 
積分
194 
點名
0  
作業系統
windows 
軟體版本
office2010 
閱讀權限
20 
性別
女 
註冊時間
2016-9-22 
最後登錄
2020-8-28 

論壇榮譽勳章論壇贊助勳章
51# 跳轉到 »
發表於 2016-10-27 17:54 | 只看該作者
回復 49# GBKEE


   1 回版大
    一開始的是對的  
    您修改後的反而不對了~
   
     此圖的意思是，EX:上面的前五項資料 就是符合 "TR排機&產出" 第一行的資訊所篩選出來的
     相對的這些資料是從工作表2篩出來的，下面的資訊是工作表2排除那5筆剩下的資料，工作表2的數量已經從大至小排好了
     就由數量大到小呈現就可以了
   

   
   
    這張圖是版大地2個ListBox ，確實是要呈現這樣的資訊
    只是好像少了幾項內容
   
    會有這10攔的內容

    因為我目前還卡在型態偵測錯誤這階段
    所以我也看不出版大地2個ListBox呈現的資料是不是這些...
   
    PS:   第一個ListBox的這兩筆資訊可以對調位置嗎，貼上去的部分也剛好顛倒了
   


    TR00.rar (569.88 KB)

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
52#
發表於 2016-10-27 19:24 | 只看該作者
回復 51# starbox520

EX:上面的前五項資料 就是符合 "TR排機&產出" 第一行的資訊所篩選出來的,  請用圖示標出哪一行
會有這10攔的內容:2003版ListBox只能顯示9欄
  1.   
  2. '44# 所說出現偵錯錯誤...
  3. ' 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
  4.             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
複製代碼


第一個ListBox的這兩筆資訊可以對調位置嗎，貼上去的部分也剛好顛倒了
看圖示 是哪裡調位置
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

starbox520

帖子
192 
主題
15 
精華
0 
積分
194 
點名
0  
作業系統
windows 
軟體版本
office2010 
閱讀權限
20 
性別
女 
註冊時間
2016-9-22 
最後登錄
2020-8-28 

論壇榮譽勳章論壇贊助勳章
53#
發表於 2016-10-27 22:39 | 只看該作者
回復 52# GBKEE


     可以了...原來是我放錯地方
     C大的方法是可行的~~~~~!!!!
     原始的工作表2我也修正好了!!!!
     原來這個關係是從我這邊出了問題....
   
      剩下的ListBox1   剩下的資料有辦法在加數量由大至小上去嗎
      #49(1)   所說的
     
     第2個LIstBox可以改成這9攔嗎
     


     附上我也修改好的    TR00.rar (569.21 KB)

TOP

starbox520

帖子
192 
主題
15 
精華
0 
積分
194 
點名
0  
作業系統
windows 
軟體版本
office2010 
閱讀權限
20 
性別
女 
註冊時間
2016-9-22 
最後登錄
2020-8-28 

論壇榮譽勳章論壇贊助勳章
54#
發表於 2016-10-27 22:47 | 只看該作者
回復 52# GBKEE


      系統顯示編輯時間超過了
      第2個LIstBox可以改成這9攔嗎   ( T/Y改成customer)     時間的資料大大您取到B欄"Queue Time"應該是P欄"Oven OutTime"
       Customer       Location       Device     Package      BodySize     LC        QTY        Schedule       Oven OutTime

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
55#
發表於 2016-10-28 05:18 | 只看該作者
本帖最後由 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

starbox520

帖子
192 
主題
15 
精華
0 
積分
194 
點名
0  
作業系統
windows 
軟體版本
office2010 
閱讀權限
20 
性別
女 
註冊時間
2016-9-22 
最後登錄
2020-8-28 

論壇榮譽勳章論壇贊助勳章
56#
發表於 2016-10-28 09:12 | 只看該作者
回復 55# GBKEE

         
    回版大  我可能放在工作表2讓版大混淆這兩個資訊的關係
    這兩個資訊是完全沒有關係的....
   
    您目前第一個ListBox的資訊是對的，(是依據"工作表2"的Package.BodySize.LC  對應至"TR排機&產出")
    您呈現出來的資料是對的
    我後來解釋給版大的這張圖
    第一步.........是循問版大如果依條件篩選完後，呈現出來的這幾筆資料顯示在第一個ListBox後
    這幾筆資料是從工作表2去比對"TR排機&產出"
   
     第二步........... 下面那些資訊和"TR排機&產出"完全沒關係
     只是要把工作表2在"第一步"篩完剩下的資訊   
     以Package.BodySize相同，數量由大致小做排列
        
     再把結果接著放在
     第一個ListBox"第一步"做好的資訊下接著呈現  (下方資訊應不該再出現"第一步"的資訊)

TOP

starbox520

帖子
192 
主題
15 
精華
0 
積分
194 
點名
0  
作業系統
windows 
軟體版本
office2010 
閱讀權限
20 
性別
女 
註冊時間
2016-9-22 
最後登錄
2020-8-28 

論壇榮譽勳章論壇贊助勳章
57#
發表於 2016-10-29 01:25 | 只看該作者
回復 56# starbox520


    回版大 我後來有自己排出來了!!!!
    讓您頭痛了XDDD.....
    請問為什麼顯示一筆資料的時候會這樣呢
   

   
  1. Private Sub lstSelector_設定()
  2.     With lstSelector
  3.              ' **取消     .MultiSelect = 1            *** MultiSelect 屬性  指定物件是否接受多重選取。
  4.        If Not IsEmpty(Sheets("TR排機&產出").Sh_Ar) Then .List = Sheets("TR排機&產出").Sh_Ar
  5.     End With
  6.     With ListBox1  '**frmSelector中的第二個ListBox 控制項
  7.         .ColumnCount = 9
  8.         .ColumnWidths = "60,35,75,40,30,60,30,70,30"
  9.    
  10.     End With
  11. End Sub
  12. Private Sub lstSelector_Change()
  13.     If lstSelector.ListIndex > -1 Then Ex_WIP
  14. End Sub
  15. Private Sub Ex_WIP()
  16.     Dim i As Integer, Ar, A(1 To 4), Ab(), ii As Integer
  17.        With Me.lstSelector
  18.             For i = 0 To 3
  19.                 A(i + 1) = .List(.ListIndex, i)
  20.             Next
  21.        End With
  22.        i = 2
  23.     With Sheets("WIP")
  24.         Do While .Cells(i, 1) <> ""
  25.           '  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
  26.             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
  27.                
  28.                 If IsEmpty(Ar) Then ReDim Ar(1 To 1) Else ReDim Preserve Ar(1 To UBound(Ar) + 1)
  29.          '顯示我要的資料
  30.          Ar(UBound(Ar)) = Array(.Cells(i, "A").Text, .Cells(i, "C").Text, .Cells(i, "D").Text, .Cells(i, "E").Text, .Cells(i, "G").Text, .Cells(i, "F").Text, .Cells(i, "K").Text, .Cells(i, "I").Text, .Cells(i, "P").Text) 'K欄
  31.          
  32.          
  33.                  '** Listbox 最多顯示 9列
  34.             End If
  35.             i = i + 1
  36.         Loop
  37.     End With
  38.     '***********************************
  39.     '**frmSelector中的第二個ListBox 控制項
  40.     With ListBox1
  41.         .Clear
  42.         If UBound(Ar) > 1 Then
  43.              .List = Application.Transpose(Application.Transpose(Ar))
  44.         ElseIf UBound(Ar) = 1 Then
  45.             .List = Ar(1)
  46.         End If
  47.     End With
  48.     '***********************************
  49. End Sub


  52. '******************************
  53. Public Sh_Rng As Range, Sh_Ar
  54. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  55.     If IsError(Target(1)) Then Unload frmSelector:         Exit Sub
  56.     If (Target(1).Row + 1) Mod 5 = 0 And Target(1) <> "" And Target(1).Column = 5 Then
  57.         Set Sh_Rng = Cells(Target(1).Row, "E")
  58.         Ex_Customer_Package
  59.         If IsEmpty(Sh_Ar) Then MsgBox Sh_Rng & "-" & Sh_Rng(1, 2) & vbLf & "找不到": Exit Sub
  60.         Unload frmSelector
  61.         frmSelector.Show False
  62.     Else
  63.         Unload frmSelector
  64.     End If
  65. End Sub
  66. Private Sub Ex_Customer_Package()


  69.     Dim i As Integer, ii As Integer, Ar
  70.     Sh_Ar = Ar:    i = 2
  71.     With Sheets("工作表2")
  72.         Do While .Cells(i, 1) <> ""
  73.             If .Cells(i, 1) = Sh_Rng And .Cells(i, 2) = Sh_Rng(1, 2) Then
  74.             If IsEmpty(Ar) Then ReDim Ar(1 To 8, 1 To 1) Else ReDim Preserve Ar(1 To 8, 1 To UBound(Ar, 2) + 1)
  75.                 For ii = 1 To 8
  76.                 Ar(ii, UBound(Ar, 2)) = .Cells(i, ii).Text
  77.                 Next
  78.             End If
  79.             i = i + 1
  80.         Loop
  81.     End With
  82.     If IsEmpty(Ar) Then Exit Sub
  83.     Sh_Ar = Application.Transpose(Ar)
  84. End Sub
複製代碼

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
58#
發表於 2016-10-29 07:16 | 只看該作者
回復 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

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
59#
發表於 2016-10-29 09:05 | 只看該作者
本帖最後由 c_c_lai 於 2016-10-29 09:10 編輯

回復 57# starbox520
參照
"輸入資料比對資料表 轉換到別的資料表 #12"
的修正。
  1.     '******   By GBKEE  ******
  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.             .AddItem
  9.             For i = 0 To UBound(Ar(1))
  10.                 .List(0, i) = Ar(1)(i)
  11.             Next i
  12.         End If
  13.     End With
  14.     '***********************************
複製代碼

TOP

starbox520

帖子
192 
主題
15 
精華
0 
積分
194 
點名
0  
作業系統
windows 
軟體版本
office2010 
閱讀權限
20 
性別
女 
註冊時間
2016-9-22 
最後登錄
2020-8-28 

論壇榮譽勳章論壇贊助勳章
60#
發表於 2016-10-29 12:17 | 只看該作者
回復 59# c_c_lai
  1. Public Sh_Rng As Range, Sh_Ar
  2. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  3.    
  4.     If IsError(Target(1)) Then Unload frmSelector:         Exit Sub
  5.     If (Target(1).Row + 1) Mod 5 = 0 And Target(1) <> "" And Target(1).Column = 5 Then
  6.         
  7.         Set Sh_Rng = Cells(Target(1).Row, "E")
  8.         Ex_Customer_Package
  9.         
  10.         If IsEmpty(Sh_Ar) Then MsgBox Sh_Rng & "-" & Sh_Rng(1, 2) & vbLf & "找不到": Exit Sub
  11.         Unload frmSelector
  12.         frmSelector.Show False
  13.     Else
  14.         Unload frmSelector
  15.     End If
  16. End Sub
  17. Private Sub Ex_Customer_Package()

  19.     Dim i As Integer, ii As Integer, Ar
  20.     Sh_Ar = Ar:    i = 2
  21.    
  22.     With Sheets("工作表2")
  23.         Do While .Cells(i, 1) <> ""
  24.             If .Cells(i, 1) = Sh_Rng And .Cells(i, 2) = Sh_Rng(1, 2) Then
  25.             
  26.             If IsEmpty(Ar) Then ReDim Ar(1 To 8, 1 To 1) Else ReDim Preserve Ar(1 To 8, 1 To UBound(Ar, 2) + 1)
  27.                 For ii = 1 To 8
  28.                 Ar(ii, UBound(Ar, 2)) = .Cells(i, ii).Text
  29.                 Next
  30.             End If
  31.             i = i + 1
  32.         
  33.         Loop
  34.     End With
  35.    
  36.     If IsEmpty(Ar) Then Exit Sub
  37.     Sh_Ar = Application.Transpose(Ar)
  38.    
  39. End Sub
複製代碼
這是第一個listbox
   也是出現一樣的情形
   像這情況要怎麼做修改呢

TOP

        靜思自在 : 人的心地是一畦田，土地沒有播下好種子，也長不出好的果實。 -
12345678
返回列表 上一主題