GBKEE

¦^´_ 28# starbox520

1. Private Sub CommandButton1_Click()
   
2.     Dim AA(), xi As Integer
   
3.     ' With frmSelector ³o¬Oªí³æª«¥ó¤£¬OListBox   **·|¦³¿ù»~ªº
   
4.     'With frmSelector.lstSelector  ¤]¥i¥Î³oªí³æª«ªº¤lª«¥ó(ListBox)
   
5.     With lstSelector   'ª«¥ó(ListBox)
   
6.         If .ListIndex > 0 Then         'ListBox²M³æ¤¤¿ï¨ú¦Cªº¯Á¤Þ­È ,   -1 ªí¨S¦³¿ï¨ú
   
7.         '**  0 ¬°ªíÀY ¦p­n¿ï¨ú ¥i§ï¬° If .ListIndex > -1 Then
   
8.             
   
9.             '  ¨ú¥X¸Ó¦æ¤§¼Æ¾Ú¡A¦s¤J AA °}¦C¤¤
   
10.             AA = Application.Index(.List, .ListIndex + 1)
    
11.             With Sheets("sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1)  '.Offset(1)  '**ÁÙ¬O¤U¤@Àx¦s®æ
    
12.                         .Cells.Resize(, 9) = AA
    
13.                     'ÁÙ¬O .Cells = .Cells + AA '¸ê®Æ¬O²Ö¿nªº
    
14.                     '***AA¬°°}¦C¤£¥i¥Î¦¹»yªk**
    
15.                 End With
    
16.             End If
    
17.     End With
    
18. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 31# starbox520

¦Û°Ê¹ïÀ³¨ì¿ï¾Üªº¾÷¥x½s¸¹¥k¤âÃ䪺²Ä¤@±Æ¸ê®Æ
©Ò»¡: ¬O¹ïÀ³¨ì¦p¹Ï¶Ü

¤U¸ü (16.64 KB)

2016-10-24 05:19

§A´Á±æ±o¨ì"¤u§@ªí1"¥ª¤W¹Ï¥Ü ¥H¹ïÀ³¦r¦êÅã¥Ü¥Xªº±Æ§Ç

¦p¹Ï¤u§@ªí2»P¤u§@ªí1 ªºÄæ¦ì¤£ºÉ¬Û¦P.
     °ÝÃD¬O¤u§@ªí2¨S¦³Äæ¦ìªº¸ê®Æ,¦p¦ó¦b¤u§@ªí1¨q¥X¨Ó,
   ¤u§@ªí1¤Wªº5µ§¸ê®Æ,¬Ý¤£¥X¦p¦ó¦b¤u§@ªí2¨ú¥X .
   ¤u§@ªí1  Customergroup  ªº5µ§¸ê®Æ,
    AVAGO  SYNAPTICS  MAXIM  MELLANOX  PMC-SIERRA
    ÃöÁp©Ê¬Ý¤£¥X¨Ó

   

¤U¸ü (51.99 KB)

2016-10-24 05:18

GBKEE

¦^´_ 36# starbox520

¬Ý¨ì³Ì«á³o¹Ï¤ù,¤~©úÁA§A¦b»¡¤°»ò.

¸Õ¸Õ¬Ý «ö§Úªºµ{¦¡½X

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Rng As Range
   
4.     Set Rng = Sheets("TR±Æ¾÷&²£¥X").Range("E4")
   
5.     Application.ScreenUpdating = False
   
6.     Do While Rng <> ""
   
7.         Ex_AutoFilter Rng              '©I¥s µ{¦¡
   
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("¤u§@ªí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.         '**'¦Û°Ê¿z¿ï  **
    
21.         .AutoFilter Field:=1, Criteria1:=Rng             '²Ä¤@­ÓÄæ¦ì , ¿z¿ï·Ç«h=Rng
    
22.         .AutoFilter Field:=2, Criteria1:=Rng(1, 2)    '²Ä¤G­ÓÄæ¦ì , ¿z¿ï·Ç«h=Rng(1, 2)
    
23.         '**'¦Û°Ê¿z¿ï  **
    
24.         .Copy xRng(2)
    
25.        End With
    
26.        Rng(2).Resize(4, 4) = xRng(2).CurrentRegion.Range("A2:D5").Value
    
27. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 38# starbox520
¤£¥Î«Ü¦h­Ó«ö¶s¤]¤£­n¥Î«ö¶s
TR±Æ¾÷&²£¥X¤W,·Æ¹«²¾¨ìEÄæ¤Wªº©Ò«ü©wªºCustomer,¨q¥Xªí³æ

TR±Æ¾÷&²£¥X¼Ò²Õªºµ{¦¡½X

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("¤u§@ªí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

½Æ»s¥N½X

frmSelectorªí³æ¼Òªýªºµ{¦¡½X

1. Option Explicit
   
2. Private Sub UserForm_Initialize()
   
3.     StartupPosition = 0
   
4.     Top = 0
   
5.     Left = Windows(1).Width - Width
   
6.     lstSelector_³]©w
   
7. End Sub
   
8. Private Sub lstSelector_³]©w()
   
9.     With lstSelector
   
10.         .ColumnCount = 8
    
11.         .MultiSelect = 1            ' MultiSelect ÄÝ©Ê  «ü©wª«¥ó¬O§_±µ¨ü¦h­«¿ï¨ú¡C
    
12.        If Not IsEmpty(Sheets("TR±Æ¾÷&²£¥X").Sh_Ar) Then .List = Sheets("TR±Æ¾÷&²£¥X").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 "§A¨S¦³¿ï¨ú¸ê®Æ"
    
29.     ElseIf UBound(AA, 2) > 4 Then
    
30.         MsgBox "§A¿ï¨ú ¶W¹L 4 µ§ ¸ê®Æ"
    
31.     Else
    
32.         If MsgBox("¦@ ¿ï¨ú " & UBound(AA, 2) & " µ§¸ê®Æ" & vbLf & "½T©w¿é¤J", vbYesNo) = vbYes Then
    
33.             With Sheets("TR±Æ¾÷&²£¥X").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

½Æ»s¥N½X

GBKEE

¦^´_ 40# starbox520
TR±Æ¾÷&²£¥X¼Ò²Õªºµ{¦¡½X



   

¤U¸ü (52.04 KB)

2016-10-25 15:02

GBKEE

¦^´_ 42# starbox520
§Aªº»¡©ú¨S¦³«ÜÁA¸Ñ.
frmSelector¼Ò²Õ,­×§ï¤@¤U¸Õ¸Õ¬Ý

1. Option Explicit
   
2. Private Sub UserForm_Initialize()
   
3.     StartupPosition = 0
   
4.     Top = 0
   
5.     Left = Windows(1).Width - Width
   
6.     lstSelector_³]©w
   
7. End Sub
   
8. Private Sub lstSelector_³]©w()
   
9.     With lstSelector
   
10.         '**¤Ï¦Êªº³¡¤À¥i¥H¥u¯à¤Ï¥Õ¤@µ§ ¡A¤£­n³o»ò¦hµ§¶Ü
    
11.       ' **¨ú®ø     .MultiSelect = 1            *** MultiSelect ÄÝ©Ê  «ü©wª«¥ó¬O§_±µ¨ü¦h­«¿ï¨ú¡C
    
12.        If Not IsEmpty(Sheets("TR±Æ¾÷&²£¥X").Sh_Ar) Then .List = Sheets("TR±Æ¾÷&²£¥X").Sh_Ar
    
13.     End With
    
14.     With ListBox1  '**frmSelector¤¤ªº²Ä¤G­Ó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 ³Ì¦hÅã¥Ü 9¦C
    
41.             End If
    
42.             i = i + 1
    
43.         Loop
    
44.     End With
    
45.     '***********************************
    
46.     '**frmSelector¤¤ªº²Ä¤G­Ó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

½Æ»s¥N½X

GBKEE

¦^´_ 44# starbox520
2003ª© ¨S¦³¿ù»~

¤U¸ü (26.56 KB)

2016-10-26 19:30

GBKEE

¦^´_ 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

½Æ»s¥N½X

¦p¦A¤£¦æ½ÐªþÀÉ

²Ä¤@­ÓListBoxÀ³¸Ó¬O¦C¥X¬Ûªñªº«á¡A³Ñ¾lªº¸ê®Æ¦A¥H¤u§@ªí2"¼Æ¶q"¤j¤pÅã¥Ü
Åã¥Ü¦b­þ¸Ì!

¤£¤F¸Ñªº¬O ªþ¹Ïªºªí¤@©Îªí¤G ÅÞ¿è¦p¦ó©wªº

¤U¸ü (17.58 KB)

2016-10-27 05:14

GBKEE

¦^´_ 48# c_c_lai
2003ª©¨S³o°ÝÃD



   

¤U¸ü (29.86 KB)

2016-10-27 13:50

PS:TR±Æ¾÷&²£¥X¼Ò²Õ
­×¥¿

1. Private Sub Ex_Customer_Package()
   
2.     Dim i As Integer, ii As Integer, Ar
   
3.     Sh_Ar = Ar:    i = 2
   
4.     With Sheets("¤u§@ªí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

½Æ»s¥N½X

GBKEE

¦^´_ 51# starbox520

EX:¤W­±ªº«e¤­¶µ¸ê®Æ ´N¬O²Å¦X "TR±Æ¾÷&²£¥X" ²Ä¤@¦æªº¸ê°T©Ò¿z¿ï¥X¨Óªº,  ½Ð¥Î¹Ï¥Ü¼Ð¥X­þ¤@¦æ
·|¦³³o10Ädªº¤º®e:2003ª©ListBox¥u¯àÅã¥Ü9Äæ

1.   
   
2. '44# ©Ò»¡¥X²{°»¿ù¿ù»~...
   
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

½Æ»s¥N½X

¤U¸ü (30.97 KB)

2016-10-27 19:22

²Ä¤@­ÓListBoxªº³o¨âµ§¸ê°T¥i¥H¹ï½Õ¦ì¸m¶Ü¡A¶K¤W¥hªº³¡¤À¤]­è¦nÄA­Ë¤F
¬Ý¹Ï¥Ü ¬O­þ¸Ì½Õ¦ì¸m