starbox520

回復 29# GBKEE


    附檔的按我 就是我想要做的問題改善
    原本是設計來開啟listBox單純此功能而已(目前ListBox的資料顯示是取用於"工作表2")
    現在要修正為如果先點機台編號在按此按鈕開啟ListBox(或是有更好的方法...)
    能否自動對應到選擇的機台編號右手邊的第一排資料
    跑出來的樣子會類似像"工作表1"左上圖示 以對應字串顯示出的排序

starbox520

我有試著自己去用矩陣方式寫入清單方塊
   可以幫我看看哪邊語法有錯誤的嗎
   Private Sub TrLowData(ByVal strPackage As String, ByVal strLC As String, ByVal strBodysize As String)
    Dim max As Integer
    max = UBound(List)
    Dim gg As Boolean
    Dim LowCustomer As String
    Dim BodySize As String
    Dim Location As String
    Dim DeviceType As String
    Dim Package As String
    Dim Schedule As String
    Dim BK As Long
    Dim LC As String
    Dim TY As String
    Dim VM As Long
    Dim TR As Long
    Dim Total  As Long
            '用工作表2去做排列 一行一行讀
    For k = 2 To 6000
        Customer = Cells(k, "A")
        Package = Cells(k, "B")
        BodySize = Cells(k, "C")
        LC = Cells(k, "D")
        BK = Cells(k, "E")
        VM = Cells(k, "F")
        TR = Cells(k, "G")
        Total = Cells(k, "H")
            If Len(Customer) = 0 Then
                Exit For
            End If
     '比對字串作排列  以PKG.LEADCOUNT.BodySize作條件篩選
     
     Next
      If (StrComp(List(i).PKG, strPackage, vbTextCompare) = 0) And _
         (StrComp(List(i).LEADCOUNT, strLC, vbTextCompare) = 0) And _
         (StrComp(List(i).BodySize, strBodysize, vbTextCompare) = 0) Then
      For i = 0 To max
     '把結果放去LISTBOX 只秀出五筆
      lstSelector.ColumnCount = 9
         For i = 1 To 5
         lstSelector.Additm
        Next i
       '這裡要keep這五個資料但是我不曉得要怎麼用語法去寫...
      
      '在秀出五筆以LEADCOUNT.PKG 作排列
       If (StrComp(List(i).LEADCOUNT, strLC, vbTextCompare) = 0) And _
          (StrComp(List(i).PKG, strPackage, vbTextCompare) = 0) And _
           For i = 0 To max
            lstSelector.ColumnCount = 9
         For i = 1 To 5
         lstSelector.Additm
        Next i

End Sub

GBKEE

回復 31# starbox520

自動對應到選擇的機台編號右手邊的第一排資料
所說: 是對應到如圖嗎

下載 (16.64 KB)

2016-10-24 05:19

你期望得到"工作表1"左上圖示 以對應字串顯示出的排序

如圖工作表2與工作表1 的欄位不盡相同.
     問題是工作表2沒有欄位的資料,如何在工作表1秀出來,
   工作表1上的5筆資料,看不出如何在工作表2取出 .
   工作表1  Customergroup  的5筆資料,
    AVAGO  SYNAPTICS  MAXIM  MELLANOX  PMC-SIERRA
    關聯性看不出來

   

下載 (51.99 KB)

2016-10-24 05:18

starbox520

回復 33# GBKEE


    回版大
    是對應到此字串沒錯
    是以工作表2資料去對應字串的"Package" 與 "BodySize"的內容作排列(數量由大致小)呈現在ListBox上
    工作表1為理想圖   應為

下載 (39.69 KB)

2016-10-24 08:26

    是我表達不清抱歉...
    若以第一欄來說  會對應到的篩選條件就是BGA  再來是17.3*7  篩完後再排列數量大小(以工作表2去做篩選)
        以第2攔來說  會對應到的篩選條件就是TQFP 再來是10*10 篩完後再排列數量大小
   

下載 (104.42 KB)

2016-10-24 08:38

下載 (57.47 KB)

2016-10-24 08:38

     圈起部分是   上面完成結果後呈現在ListBox上   點選其中某項  會直接把 這4筆資料直接貼上  (每次只貼一次)
     但因為每個機台編號第一欄資料都不同  所以才想過要以先點選儲存格再去尋找字串的方法去做排列...(我的想法)
     重新附上整理後的檔案....不好意思讓您混淆了
      0925.zip (551.96 KB)

下載次數: 3

2016-10-24 08:45

starbox520

回復 33# GBKEE

    不好意思版大
    此版較明確   
    0926TR.rar (544.82 KB)

下載次數: 10

2016-10-24 09:22

starbox520

回復 33# GBKEE


    回版大
    這些做法都是我用C#所學的觀念去弄得 所以在相容性下很多問題所以我才越寫越崩潰=  ="
    我最終目標是用"工作表2"的資料對到"TR產出"的機台邊碼上每第一列資料，去做"Package ""Bodysize"數量由大至小，可以秀出在清單方塊上
      

下載 (14.88 KB)

2016-10-24 18:53

     點選其一內容可以貼到篩選條件的下一排，
      

下載 (9.07 KB)

2016-10-24 18:53

     顯示在ListBox上會有8筆資料貼上只需其中四筆
      ps:有想過很多方法去做， 可是都卡到每一個機台編號對應的第一排篩選東西可能不同，所以才用陣列去試試看
          但爬文中又有看到物件類別模組好像能實現，只是好像似乎變成要每個機台編號都設置按鈕
           版大有較好的想法或作法嗎~"~

GBKEE

回復 36# starbox520

看到最後這圖片,才明瞭你在說什麼.

試試看 按我的程式碼

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Rng As Range
   
4.     Set Rng = Sheets("TR排機&產出").Range("E4")
   
5.     Application.ScreenUpdating = False
   
6.     Do While Rng <> ""
   
7.         Ex_AutoFilter Rng              '呼叫 程式
   
8.         Set Rng = Rng.Offset(5)
   
9.     Loop
   
10.     Application.ScreenUpdating = True
    
11. End Sub
    
12. Sub Ex_AutoFilter(Rng As Range)
    
13.     Dim xRng(1 To 2) As Range
    
14.     With Sheets("工作表2")
    
15.         Set xRng(1) = .Range("a1").CurrentRegion
    
16.         xRng(1).AutoFilter
    
17.         Set xRng(2) = Cells(1, Columns.Count - xRng(1).Columns.Count)
    
18.     End With
    
19.      With xRng(1)
    
20.         '**'自動篩選  **
    
21.         .AutoFilter Field:=1, Criteria1:=Rng             '第一個欄位 , 篩選準則=Rng
    
22.         .AutoFilter Field:=2, Criteria1:=Rng(1, 2)    '第二個欄位 , 篩選準則=Rng(1, 2)
    
23.         '**'自動篩選  **
    
24.         .Copy xRng(2)
    
25.        End With
    
26.        Rng(2).Resize(4, 4) = xRng(2).CurrentRegion.Range("A2:D5").Value
    
27. End Sub

複製代碼

starbox520

回復 37# GBKEE


    回版大篩的確實是我要的結果，
    是希望透過人工去LISTBOX點選的方法去貼在第2格
    ( 會有 customer   package  bodysize  lc  bk  vm  tr   數量   ) <-8 筆資料
     因為是我人工去選出來的所以我只有秀大概五筆
   

下載 (15.49 KB)

2016-10-24 21:00

     因為每次使用時 每個機台編號  只會取其中一項貼上去而已像我這樣
     

下載 (9.84 KB)

2016-10-24 21:04

     因為使用時不一定會要第一筆資料，要以人工去判斷  lc  bk  vm  tr   的數量   
     再以人工決定要點選一項貼上去
     所以我才會有後者所說是否要很多個按鈕的問題QQ
     又讓版大誤會我一點意思了...

GBKEE

回復 38# starbox520
不用很多個按鈕也不要用按鈕
TR排機&產出上,滑鼠移到E欄上的所指定的Customer,秀出表單

TR排機&產出模組的程式碼

1. Public Sh_Rng As Range, Sh_Ar
   
2. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
3.     If IsError(Target(1)) Then Unload frmSelector:         Exit Sub
   
4.     If (Target(1).Row + 1) Mod 5 = 0 And Target(1) <> "" And Target(1).Column = 5 Then
   
5.         Set Sh_Rng = Cells(Target(1).Row, "E")
   
6.         Ex_Customer_Package
   
7.         If IsEmpty(Sh_Ar) Then MsgBox Sh_Rng & "-" & Sh_Rng(1, 2) & vbLf & "找不到": Exit Sub
   
8.         Unload frmSelector
   
9.         frmSelector.Show False
   
10.     Else
    
11.         Unload frmSelector
    
12.     End If
    
13. End Sub
    
14. Private Sub Ex_Customer_Package()
    
15.     Dim  i As Integer, ii As Integer, Ar
    
16.     Sh_Ar = Ar:    i = 2
    
17.     With Sheets("工作表2")
    
18.         Do While .Cells(i, 1) <> ""
    
19.             If .Cells(i, 1) = Sh_Rng And .Cells(i, 2) = Sh_Rng(1, 2) Then
    
20.             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)
    
21.                 For ii = 1 To 8
    
22.                 Ar(ii, UBound(Ar, 2)) = .Cells(i, ii).Text
    
23.                 Next
    
24.             End If
    
25.             i = i + 1
    
26.         Loop
    
27.     End With
    
28.     If IsEmpty(Ar) Then Exit Sub
    
29.     Sh_Ar = Application.Transpose(Ar)
    
30. End Sub

複製代碼

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.         .ColumnCount = 8
    
11.         .MultiSelect = 1            ' MultiSelect 屬性  指定物件是否接受多重選取。
    
12.        If Not IsEmpty(Sheets("TR排機&產出").Sh_Ar) Then .List = Sheets("TR排機&產出").Sh_Ar
    
13.     End With
    
14. End Sub
    
15. Private Sub CommandButton1_Click()
    
16.     Dim AA, i As Integer, ii As Integer
    
17.     With lstSelector
    
18.         For i = 0 To .ListCount - 1
    
19.             If .Selected(i) Then
    
20.                 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)
    
21.                 For ii = 1 To 4
    
22.                     AA(ii, UBound(AA, 2)) = .List(i, ii - 1)
    
23.                 Next
    
24.             End If
    
25.         Next
    
26.     End With
    
27.     If IsEmpty(AA) Then
    
28.         MsgBox "你沒有選取資料"
    
29.     ElseIf UBound(AA, 2) > 4 Then
    
30.         MsgBox "你選取 超過 4 筆 資料"
    
31.     Else
    
32.         If MsgBox("共 選取 " & UBound(AA, 2) & " 筆資料" & vbLf & "確定輸入", vbYesNo) = vbYes Then
    
33.             With Sheets("TR排機&產出").Sh_Rng.Offset(1)
    
34.                 .Resize(4, 4) = ""
    
35.                 .Resize(UBound(AA, 2), UBound(AA)) = Application.Transpose(AA)
    
36.             End With
    
37.         End If
    
38.     End If
    
39. End Sub

複製代碼

starbox520

回復 39# GBKEE


   

下載 (43.58 KB)

2016-10-25 13:46

    版大可以放檔案上來嗎
    我怎麼輸入程式碼進去都沒有反應
     按F5一直跑錯誤耶= = "