- ©«¤l
- 5923
- ¥DÃD
- 13
- ºëµØ
- 1
- ¿n¤À
- 5986
- ÂI¦W
- 0
- §@·~¨t²Î
- win10
- ³nÅ骩¥»
- Office 2010
- ¾\ŪÅv
- 150
- ©Ê§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- Public 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½X frmSelectorªí³æ¼Òªýªºµ{¦¡½X- Option 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
½Æ»s¥N½X |
|