| ©«¤l5923 ¥DÃD13 ºëµØ1 ¿n¤À5986 ÂI¦W0  §@·~¨t²Îwin10 ³nÅ骩¥»Office 2010 ¾\ŪÅv150 ©Ê§O¨k ¨Ó¦Û¥xÆW°ò¶© µù¥U®É¶¡2010-5-1 ³Ì«áµn¿ý2022-1-23 
         
 | 
                
| ¥»©«³Ì«á¥Ñ GBKEE ©ó 2016-10-25 10:28 ½s¿è 
 ¦^´_ 38# starbox520
 ¤£¥Î«Ü¦hÓ«ö¶s¤]¤£n¥Î«ö¶s
 TR±Æ¾÷&²£¥X¤W,·Æ¹«²¾¨ìEÄæ¤Wªº©Ò«ü©wªºCustomer,¨q¥Xªí³æ
 
 TR±Æ¾÷&²£¥X¼Ò²Õªºµ{¦¡½X
 frmSelectorªí³æ¼Òªýªºµ{¦¡½X½Æ»s¥N½XPublic Sh_Rng As Range, Sh_Ar
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If IsError(Target(1)) Then Unload frmSelector:         Exit Sub
    If (Target(1).Row + 1) Mod 5 = 0 And Target(1) <> "" And Target(1).Column = 5 Then
        Set Sh_Rng = Cells(Target(1).Row, "E")
        Ex_Customer_Package
        If IsEmpty(Sh_Ar) Then MsgBox Sh_Rng & "-" & Sh_Rng(1, 2) & vbLf & "§ä¤£¨ì": Exit Sub
        Unload frmSelector
        frmSelector.Show False
    Else
        Unload frmSelector
    End If
End Sub
Private Sub Ex_Customer_Package()
    Dim  i As Integer, ii As Integer, Ar
    Sh_Ar = Ar:    i = 2
    With Sheets("¤u§@ªí2")
        Do While .Cells(i, 1) <> ""
            If .Cells(i, 1) = Sh_Rng And .Cells(i, 2) = Sh_Rng(1, 2) Then
            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)
                For ii = 1 To 8
                Ar(ii, UBound(Ar, 2)) = .Cells(i, ii).Text
                Next
            End If
            i = i + 1
        Loop
    End With
    If IsEmpty(Ar) Then Exit Sub
    Sh_Ar = Application.Transpose(Ar)
End Sub
½Æ»s¥N½XOption Explicit
Private Sub UserForm_Initialize()
    StartupPosition = 0
    Top = 0
    Left = Windows(1).Width - Width
    lstSelector_³]©w
End Sub
Private Sub lstSelector_³]©w()
    With lstSelector
        .ColumnCount = 8
        .MultiSelect = 1            ' MultiSelect Äݩʠ «ü©wª«¥ó¬O§_±µ¨ü¦h«¿ï¨ú¡C
       If Not IsEmpty(Sheets("TR±Æ¾÷&²£¥X").Sh_Ar) Then .List = Sheets("TR±Æ¾÷&²£¥X").Sh_Ar
    End With
End Sub
Private Sub CommandButton1_Click()
    Dim AA, i As Integer, ii As Integer
    With lstSelector
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                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)
                For ii = 1 To 4
                    AA(ii, UBound(AA, 2)) = .List(i, ii - 1)
                Next
            End If
        Next
    End With
    If IsEmpty(AA) Then
        MsgBox "§A¨S¦³¿ï¨ú¸ê®Æ"
    ElseIf UBound(AA, 2) > 4 Then
        MsgBox "§A¿ï¨ú ¶W¹L 4 µ§ ¸ê®Æ"
    Else
        If MsgBox("¦@ ¿ï¨ú " & UBound(AA, 2) & " µ§¸ê®Æ" & vbLf & "½T©w¿é¤J", vbYesNo) = vbYes Then
            With Sheets("TR±Æ¾÷&²£¥X").Sh_Rng.Offset(1)
                .Resize(4, 4) = ""
                .Resize(UBound(AA, 2), UBound(AA)) = Application.Transpose(AA)
            End With
        End If
    End If
End Sub
 | 
 |