starbox520

¦^´_ 69# GBKEE

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 = 6 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()
    
18. 
    
19.     Dim i As Integer, ii As Integer, Ar
    
20.     Sh_Ar = Ar:    i = 2
    
21.    
    
22.     With Sheets("¤u§@ªí2")
    
23.         Do While .Cells(i, 1) <> ""
    
24.            ' If .Cells(i, 1) = Sh_Rng And .Cells(i, 2) = Sh_Rng(1, 2) Then
    
25.             If .Cells(i, 2) = Sh_Rng And .Cells(i, 3) = Sh_Rng(1, 2) Then
    
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

½Æ»s¥N½X

¦^ª©¤j¦r¦ê¦n¹³³s¦b¤@°_¤F  

¤U¸ü (30.73 KB)

2016-11-3 18:07

TR 0007.rar (537.65 KB)

¤U¸ü¦¸¼Æ: 8

2016-11-3 18:09

starbox520

¦^´_ 71# c_c_lai


    ¦^¤j¤j  
    ¤£À´±zªº·N«ä= ="
    §Ú¬O·Ó#69  ª©¤j  ©Ò¥s§Ú­×§ïªº¥h§ïªº

starbox520

¦^´_ 74# GBKEE


    ¦nªº~ÁÂÁÂC¤j¸òª©¤j
    §Ú¦^¥h¸Õ¸Õ
    §Ú¦Ñ®a¨S¹q¸£....«¢«¢

starbox520

1. Private Sub CommandButton1_Click()
   
2.     Dim AA, i As Integer, ii As Integer
   
3.     With lstSelector
   
4.         For i = 0 To .ListCount - 1
   
5.             If .Selected(i) Then
   
6.                 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)
   
7.                 For ii = 1 To 4
   
8.                     AA(ii, UBound(AA, 2)) = .List(i, ii - 1)
   
9.                 Next
   
10.             End If
    
11.         Next
    
12.     End With
    
13.     If IsEmpty(AA) Then
    
14.         MsgBox "§A¨S¦³¿ï¨ú¸ê®Æ"
    
15.     ElseIf UBound(AA, 2) > 4 Then
    
16.         MsgBox "§A¿ï¨ú ¶W¹L 4 µ§ ¸ê®Æ"
    
17.     Else
    
18.         If MsgBox("¦@ ¿ï¨ú " & UBound(AA, 2) & " µ§¸ê®Æ" & vbLf & "½T©w¿é¤J", vbYesNo) = vbYes Then
    
19.             With Sheets("TR±Æ¾÷&²£¥X").Sh_Rng.Offset(1)
    
20.                 .Resize(4, 4) = ""
    
21.                 .Resize(UBound(AA, 1), UBound(AA)) = Application.Transpose(AA)
    
22.             End With
    
23.         End If
    
24.     End If
    
25. End Sub

½Æ»s¥N½X

¦^´_ 74# GBKEE

µ²ªG´«¶K¤W³oÃä¦h©¹¥kÃä²¾¤@®æ¤F...

¤U¸ü (17.05 KB)

2016-11-8 08:33

starbox520

¦^´_ 78# jeffrey628litw


    ¨S¿ù³o°¦µ{¦¡¥Î¤F«Ü¦h«e½úªººëÀH
   
    ¾Ç¨ì¤F«Ü¦hªF¦è