12345678
返回列表 上一主題 發帖

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

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
41# 跳轉到 »
發表於 2016-10-25 15:02 | 只看該作者
回復 40# starbox520
TR排機&產出模組的程式碼



   
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

starbox520

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

論壇榮譽勳章論壇贊助勳章
42#
發表於 2016-10-25 15:40 | 只看該作者
回復 41# GBKEE


    可以了!!!!G大真是學海無崖....這些東西我找了好幾個禮拜都無從下手....
    這個方法我完全沒想到過...
    只是ListBox裡的資料前面篩選完後 要怎麼把剩下的資料(工作表2)放在後面呢(反百的部分可以只能反白一筆 ，不要這麼多筆嗎)
    因為下面那個ListBox2我要做未加總前的資料(要從WIP去找)可能會用到上面ListBox反白後就可以直接顯示在下面ListBox
    工作表2的東西是我從WIP那邊寫過來的
    ListBox2的資料要對應ListBox1反白後Customer  .  Package  .BodySize .  LC  (從WIP去找這4個相同的)
    然後呈現"Customer"  ."Location"   ."Device Type"   ."Package".   "BodySize".   "LC".   "QTY"  ."T/Y"  ."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兔年全勤獎章
43#
發表於 2016-10-26 06:48 | 只看該作者
回復 42# starbox520
你的說明沒有很瞭解.
frmSelector模組,修改一下試試看
  1. Option Explicit
  2. Private Sub UserForm_Initialize()
  3.     StartupPosition = 0
  4.     Top = 0
  5.     Left = Windows(1).Width - Width
  6.     lstSelector_設定
  7. End Sub
  8. Private Sub lstSelector_設定()
  9.     With lstSelector
  10.         '**反百的部分可以只能反白一筆 ，不要這麼多筆嗎
  11.       ' **取消     .MultiSelect = 1            *** MultiSelect 屬性  指定物件是否接受多重選取。
  12.        If Not IsEmpty(Sheets("TR排機&產出").Sh_Ar) Then .List = Sheets("TR排機&產出").Sh_Ar
  13.     End With
  14.     With ListBox1  '**frmSelector中的第二個ListBox 控制項
  15.         .ColumnCount = 9
  16.         .ColumnWidths = "60,35,75,40,30,60,30,70,30"
  17.     End With
  18. End Sub
  19. Private Sub lstSelector_Change()
  20.     If lstSelector.ListIndex > -1 Then Ex_WIP
  21. End Sub
  22. Private Sub Ex_WIP()
  23.     Dim i As Integer, Ar, A(1 To 4), Ab(), ii As Integer
  24.        With Me.lstSelector
  25.             For i = 0 To 3
  26.                 A(i + 1) = .List(.ListIndex, i)
  27.             Next
  28.        End With
  29.        i = 2
  30.     With Sheets("WIP")
  31.         Do While .Cells(i, 1) <> ""
  32.             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
  33.                 If IsEmpty(Ar) Then ReDim Ar(1 To 1) Else ReDim Preserve Ar(1 To UBound(Ar) + 1)
  34.                 ReDim Ab(1 To 1, 1 To 9)
  35.                 For ii = 1 To 8
  36.                    Ab(1, ii) = .Cells(i, ii + 1) ' 8欄資料: B欄- I欄
  37.                Next
  38.                Ab(1, 9) = .Cells(i, "K") 'K欄
  39.                Ar(UBound(Ar)) = Ab
  40.                  '** Listbox 最多顯示 9列
  41.             End If
  42.             i = i + 1
  43.         Loop
  44.     End With
  45.     '***********************************
  46.     '**frmSelector中的第二個ListBox 控制項
  47.     With ListBox1
  48.         .Clear
  49.         If UBound(Ar) > 1 Then
  50.              .List = Application.Transpose(Application.Transpose(Ar))
  51.         ElseIf UBound(Ar) = 1 Then
  52.             .List = Ar(1)
  53.         End If
  54.     End With
  55.     '***********************************
  56. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

starbox520

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

論壇榮譽勳章論壇贊助勳章
44#
發表於 2016-10-26 14:47 | 只看該作者
回復 43# GBKEE


回版大
出現偵錯錯誤...


1.  第一個ListBox應該是列出相近的後，剩餘的資料再以工作表2"數量"大小顯示


2.第二個ListBox呈現方法是，點其中一項，會出現從"WIP"資料裡的抓出紅筆圈選對應相同的資料
ListBox2  會像以下圖示(會抓取WIP資料   10個欄位的資料)

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
45#
發表於 2016-10-26 19:30 | 只看該作者
回復 44# starbox520
2003版 沒有錯誤

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

starbox520

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

論壇榮譽勳章論壇贊助勳章
46#
發表於 2016-10-26 20:50 | 只看該作者
本帖最後由 starbox520 於 2016-10-26 20:51 編輯

回復 45# GBKEE
  1. Option Explicit
  2. Private Sub UserForm_Initialize()
  3.     StartupPosition = 0
  4.     Top = 0
  5.     Left = Windows(1).Width - Width
  6.     lstSelector_設定
  7. End Sub
  8. Private Sub lstSelector_設定()
  9. With lstSelector
  10.         '**反百的部分可以只能反白一筆 ，不要這麼多筆嗎
  11.       ' **取消     .MultiSelect = 1            *** MultiSelect 屬性  指定物件是否接受多重選取。
  12.        If Not IsEmpty(Sheets("TR排機&產出").Sh_Ar) Then .List = Sheets("TR排機&產出").Sh_Ar
  13.     End With
  14.     With ListBox1  '**frmSelector中的第二個ListBox 控制項
  15.         .ColumnCount = 9
  16.         .ColumnWidths = "60,35,75,40,30,60,30,70,30"
  17.     End With
  18. End Sub
  19. Private Sub lstSelector_Change()
  20.     If lstSelector.ListIndex > -1 Then Ex_WIP
  21. End Sub
  22. Private Sub Ex_WIP()
  23.     Dim i As Integer, Ar, A(1 To 4), Ab(), ii As Integer
  24.        With Me.lstSelector
  25.             For i = 0 To 3
  26.                 A(i + 1) = .List(.ListIndex, i)
  27.             Next
  28.        End With
  29.        i = 2
  30.     With Sheets("WIP")
  31.         Do While .Cells(i, 1) <> ""
  32.             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
  33.                 If IsEmpty(Ar) Then ReDim Ar(1 To 1) Else ReDim Preserve Ar(1 To UBound(Ar) + 1)
  34.                 ReDim Ab(1 To 1, 1 To 9)
  35.                 For ii = 1 To 8
  36.                    Ab(1, ii) = .Cells(i, ii + 1) ' 8欄資料: B欄- I欄
  37.                Next
  38.                Ab(1, 9) = .Cells(i, "K") 'K欄
  39.                Ar(UBound(Ar)) = Ab
  40.                  '** Listbox 最多顯示 9列
  41.             End If
  42.             i = i + 1
  43.         Loop
  44.     End With
  45. With ListBox1
  46.         .Clear
  47.         If UBound(Ar) > 1 Then
  48.              .List = Application.Transpose(Application.Transpose(Ar))
  49.         ElseIf UBound(Ar) = 1 Then
  50.             .List = Ar(1)
  51.         End If
  52.     End With
  53.     '***********************************
  54. End Sub
  55. Private Sub CommandButton1_Click()
  56.     Dim AA, i As Integer, ii As Integer
  57.     With lstSelector
  58.         For i = 0 To .ListCount - 1
  59.             If .Selected(i) Then
  60.                 If IsEmpty(AA) Then ReDim AA(1 To 4, 1 To 1) Else ReDim Preserve AA(1 To 4, 1 To UBound(AA, 2) + 1)
  61.                 For ii = 1 To 4
  62.                     AA(ii, UBound(AA, 2)) = .List(i, ii - 1)
  63.                 Next
  64.             End If
  65.         Next
  66.     End With
  67.     If IsEmpty(AA) Then
  68.         MsgBox "你沒有選取資料"
  69.     ElseIf UBound(AA, 2) > 4 Then
  70.         MsgBox "你選取 超過 4 筆 資料"
  71.     Else
  72.         If MsgBox("共 選取 " & UBound(AA, 2) & " 筆資料" & vbLf & "確定輸入", vbYesNo) = vbYes Then
  73.             With Sheets("TR排機&產出").Sh_Rng.Offset(1)
  74.                 .Resize(4, 4) = ""
  75.                 .Resize(UBound(AA, 2), UBound(AA)) = Application.Transpose(AA)
  76.             End With
  77.         End If
  78.     End If
  79. End Sub
複製代碼
哪裡錯了呢= =他一直說型態不符... 我是2010的應該跟2003相通呀....
一直顯示Ar的參數型態有問題

第一個ListBox應該是列出相近的後，剩餘的資料再以工作表2"數量"大小顯示
這個可以列入嗎

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
47#
發表於 2016-10-27 05:15 | 只看該作者
本帖最後由 GBKEE 於 2016-10-27 05:17 編輯

回復 46# starbox520
  1.   c_c_lai 提供 高於2003版
  2.             '  Sheets("WIP").Cells(i, "F").Value : 950 : Variant/Double : A(4) : "950" : Variant/String
  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應該是列出相近的後，剩餘的資料再以工作表2"數量"大小顯示
顯示在哪裡!

不了解的是 附圖的表一或表二 邏輯如何定的

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

c_c_lai

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

回復 46# starbox520
一般在使用 Sheets("WIP").Cells(i, "F")  時，我們均確信
Sheets("WIP").Cells(i, "F") 會傳回值 950 (舉例假設)，同時
A(4) 值亦是  950 (舉例假設)。
經觀察 Sheets("WIP") 的 F 欄內存放值均為 數值型態 (Double)，
當你將兩者做對等的比對時便會產生不等值，便視為 "兩者" 間條件不符合 (不成立)
(一個為字串型態、另一個為雙精準 [比對時它不會自動轉換為字串型態]) 而跳過不處理。
結果，接下來當你欲將前面經 "比對運作" 產生的 Ar 變數拿來運用時，
因之前所有比對均無一條件成立，Ar 內容值當然為空值 (Empty)，
是故當拿它要 Assign 值給 .List 時，便產生了你看到的畫面結局了。
  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
複製代碼
便 OK 了。

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
49#
發表於 2016-10-27 13:50 | 只看該作者
本帖最後由 GBKEE 於 2016-10-27 13:53 編輯

回復 48# c_c_lai
2003版沒這問題



   


PS:TR排機&產出模組
修正
  1. Private Sub Ex_Customer_Package()
  2.     Dim i As Integer, ii As Integer, Ar
  3.     Sh_Ar = Ar:    i = 2
  4.     With Sheets("工作表2")
  5.         Do While .Cells(i, 1) <> ""
  6.             If .Cells(i, 1) = Sh_Rng And .Cells(i, 2) = Sh_Rng(1, 2) Then
  7.             If IsEmpty(Ar) Then ReDim Ar(1 To 1) Else ReDim Preserve Ar(1 To UBound(Ar) + 1)
  8.             Ar(UBound(Ar)) = .Cells(i, 1).Resize(, 4)
  9.             End If
  10.             i = i + 1
  11.         Loop
  12.     End With
  13.     If IsEmpty(Ar) Then Exit Sub
  14.     If UBound(Ar) = 1 Then
  15.         Sh_Ar = Ar(1)
  16.         Else
  17.     Sh_Ar = Application.Transpose(Application.Transpose(Ar))
  18.     End If
  19. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

starbox520

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

論壇榮譽勳章論壇贊助勳章
50#
發表於 2016-10-27 16:58 | 只看該作者
回復 48# c_c_lai


    回CC大
    修改後問題還是存在...
    TTR001.rar (566.99 KB)

TOP

        靜思自在 : 人生沒有所有權，只有生命的使用權。
12345678
返回列表 上一主題