µ{¦¡½X­×§ï

man65boy

½Ð¦Ñ®v­ÌÀ°¤p§Ì­×§ï¤@¤Uµ{¦¡½X¡A2ºØªºµ{¦¡µLªk¨ú±o¬Û¿Ä¡AªþÀÉ»¡©ú¡AÁÂÁÂ!
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xR As Range, MM
With Target
     If .Columns.Count > 1 Then Exit Sub
     If .Column <> 6 Then Exit Sub '¥iÅܧóŪ¨úÄæ¦ì
     If .Row < 2 Then Exit Sub
     If Target.Count > 3 Then Application.ScreenUpdating = False
     '¶W¹L¤Tµ§ªº¡A­áµ²°õ¦æ¹Lµ{¡Aª½¨ìµ²§ô¡A¥[§Ö°õ¦æ³t«×
     For Each xR In Target
        With xR.Cells(1, 2)
             .FormulaR1C1 = "=VLOOKUP(RC[-1],²£«~½s¸¹!C[-6]:C[-2],2,0)"
             .Value = .Value
             .Replace "#N/A", "", Lookat:=xlWhole '²M°£§ä¤£¨ì²Å¦X½s¸¹ªº¿ù»~­È
             .Replace "0", "" '²M°£¹ïÀ³½s¸¹¡e«È¤á¦WºÙ¡f«oªÅ¥Õªº¢¯­È
        End With
        Next
End With
With Target
If Target.Columns.Count > 1 Then Exit Sub
If Target.Column <> Range("M1").Column Then Exit Sub
For Each xR In Target
    If xR = "" Then GoTo NEXT_CELL
    MM = Application.Match(xR, Sheets("Sheet1").Range("A:A"), 0)
    If IsError(MM) Then GoTo NEXT_CELL
    xR = Sheets("Sheet1").Range("B" & MM).Value
NEXT_CELL:

Next
End With
End Sub





Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 13 And Target.Count = 1 Then UserForm3.Show 0
If Target.Column = 6 And Target.Count = 1 Then UserForm4.Show 0
End Sub

GBKEE

¦^´_ 3# man65boy
UserForm3,UserForm4
³£¦³

1. Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
   
2.   a1 = ListBox1.Value
   
3.   ActiveCell = IIf(ActiveCell = "", a1, ActiveCell & "¡B" & a1)
   
4. End Sub

½Æ»s¥N½X

ªí¥Ü¥i½Æ¿ï

«Øij
UserForm4

1. Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
   
2.     Dim A As String, Ar As Variant
   
3.     A = UCase(ListBox1.Value)
   
4.     Ar = Filter(Split(ActiveCell, "¡B"), A)
   
5.     If UBound(Ar) = -1 Then  'ListBox1.Value ¤£¦b ActiveCell¤¤
   
6.         Ar = Application.Evaluate("VLOOKUP(""" & A & """,²£«~½s¸¹!a:b,2,0)")
   
7.         If IsError(Ar) Then  '§ä¤£¨ì¨Ï¥Î³W®æ©Î¨Ï¥Î³W®æ=""
   
8.             MsgBox A & " §ä¤£¨ì¨Ï¥Î³W®æ ©Î ¨Ï¥Î³W®æ =  """""
   
9.         Else
   
10.             T = IIf(T <> "", T & "¡B" & MM, MM)
    
11.             ActiveCell = UCase(IIf(ActiveCell = "", A, ActiveCell & "¡B" & A))
    
12.         End If
    
13.     Else
    
14.         MsgBox A & "¤w¿ï¾Ü"
    
15.     End If
    
16. End Sub

½Æ»s¥N½X

¤u§@ªí¼Ò²Õ

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Ex Target, False
   
3. End Sub
   
4. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
5.     Ex Target, True
   
6. End Sub
   
7. Private Sub Ex(ByVal Target As Range, Form_Show As Boolean)
   
8.     Application.EnableEvents = False
   
9.     With Target
   
10.         If .Count = 1 And .Row >= 2 Then
    
11.             If .Column = 6 Then
    
12.                ½s¸¹ .Cells, Sheets("²£«~½s¸¹")
    
13.                If Form_Show Then UserForm4.Show False
    
14.             ElseIf .Column = 13 Then
    
15.                 ½s¸¹ .Cells, Sheets("Sheet1")
    
16.                 If Form_Show Then UserForm3.Show False
    
17.             End If
    
18.         End If
    
19.     End With
    
20.     Application.EnableEvents = True
    
21. End Sub
    
22. Private Sub ½s¸¹(ByVal Target As Range, Sh As Worksheet)
    
23.     Dim Ar As Variant, e As Variant, MM As Variant, T As String
    
24.     Dim Rng As Range
    
25.     Set Rng = Sh.Range("A:B")
    
26.     Ar = Split(Target, "¡B")
    
27. Ag:
    
28.     For Each e In Ar
    
29.         MM = Application.Evaluate("VLOOKUP(""" & e & """," & Rng.Address(, , , 1, 1) & ",2,0)")
    
30.         If IsError(MM) Then Exit For
    
31.         T = IIf(T <> "", T & "¡B" & MM, MM)
    
32.     Next
    
33.     If IsError(MM) Then GoTo Er:
    
34.     If Sh.Name = "²£«~½s¸¹" Then
    
35.         Target.Offset(, 1) = T
    
36.     Else
    
37.         Target = T
    
38.     End If
    
39.     Exit Sub
    
40. Er:
    
41.     Ar = Filter(Ar, e, False)
    
42.     Target = Join(Ar, "¡B")
    
43.     T = ""
    
44.     If e = "" Then Exit Sub
    
45.     GoTo Ag
    
46. End Sub

½Æ»s¥N½X

man65boy

¦^´_ 2# ­ã´£³¡ªL

ÁÂÁ·Ǥj¦Ñ®vªº¸ÑÃDÀ°¦£¡A§¹¥þ²Å¦X»Ý­n¡A·P¿E¤£ºÉ^^

­ã´£³¡ªL

Private Sub Worksheet_Change(ByVal Target As Range)
Dim xR As Range, MM
With Target
¡@¡@If .Columns.Count > 1 Then Exit Sub
¡@¡@If .Row < 2 Then Exit Sub
¡@¡@If .Column = [F1].Column Then
¡@¡@¡@¡@With .Offset(, 1)
¡@¡@¡@¡@¡@¡@.FormulaR1C1 = "=VLOOKUP(RC[-1],²£«~½s¸¹!C[-6]:C[-2],2,0)"
¡@¡@¡@¡@¡@¡@.Value = .Value
¡@¡@¡@¡@¡@¡@.Replace "#N/A", "", Lookat:=xlWhole
¡@¡@¡@¡@¡@¡@.Replace "0", ""
¡@¡@¡@¡@End With
¡@¡@ElseIf .Column = [M1].Column Then
¡@¡@¡@¡@On Error Resume Next
¡@¡@¡@¡@Application.EnableEvents = False
¡@¡@¡@¡@For Each xR In Target
¡@¡@¡@¡@¡@¡@MM = Application.Match(xR, Sheets("Sheet1").Range("A:A"), 0)
¡@¡@¡@¡@¡@¡@If IsNumeric(MM) Then xR = Sheets("Sheet1").Range("B" & MM).Value
¡@¡@¡@¡@Next
¡@¡@End If
End With
Application.EnableEvents = True
End Sub