GBKEE

¦^´_ 1# emma
¥u­n¦³¥]§t100ªº¸Ü­n±ø¥ó¦A¿ï¾Ü  ³o¬O¦r¦êªº¿z¿ï¤è¦¡
Zip CodeÄæ ªº¸ê®Æ¬O¼Æ¦r,­n·í¦r¦ê¥Î ¶·¥þ³¡ªº¼Æ¦r«e ' ¦p '10058 ¨t²Î·|±Nµø¬°¤å¦r  ,¤~¥i¥H¥Î¦r¦êªº¿z¿ï¤è¦¡/
¸Õ¸Õ¬Ý
Sheet1¤u§@ªí ¼Ò²Õªºµ{¦¡½X

1. Option Explicit
   
2. Private Sub Worksheet_Change(ByVal Target As Range)
   
3.     If Target.Address(0, 0) = "B1" Then
   
4.         Range("A3").AutoFilter Field:=1, Criteria1:=Target & "*"
   
5.     End If
   
6. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 3# emma
AutoFilte: ¦Û°Ê¿z¿ï ¥i¬Ývbaªº»¡©ú

GBKEE

¦^´_ 5# emma
¸Õ¸Õ¬Ý

1. Option Explicit
   
2. Private Sub Worksheet_Change(ByVal Target As Range)
   
3.     Dim Target_Row As String
   
4.     If Target.Address(0, 0) = "D1" Then
   
5.         Range("C3").AutoFilter Field:=3, Criteria1:="*" & Target & "*"
   
6.     ElseIf Target.Address(0, 0) = "B1" Then
   
7.         Range("A3").AutoFilter Field:=1, Criteria1:="*" & Target & "*"
   
8.     End If
   
9. End Sub
   
10. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
11.     Dim Target_Row As String, xi As Integer, xi_Row As String
    
12.     If Not Application.Intersect(Range("A4", Range("A4").End(xlDown)), Target) Is Nothing Then
    
13.         'Intersectª«¥ó
    
14.         Target_Row = Join(Application.Transpose(Application.Transpose(Target.Resize(, 5))), ",")
    
15.         'Join ¨ç¼Æ:¶Ç¦^¤@­Ó¦r¦ê¡A¸Ó¦r¦ê¬O³z¹L³sµ²¬Y­Ó°}¦C¤¤ªº¦h­Ó¤l¦r¦ê¦Ó«Ø¥ßªº¡C
    
16.         xi = 7
    
17.         Do While Sheets("sheet2").Cells(xi, 1) <> ""
    
18.            xi_Row = Join(Application.Transpose(Application.Transpose(Sheets("sheet2").Cells(xi, 1).Resize(, 5))), ",")
    
19.            If xi_Row = Target_Row Then Exit Sub
    
20.            xi = xi + 1
    
21.         Loop
    
22.         Sheets("sheet2").Cells(xi, 1).Resize(, 5) = Split(Target_Row, ",")
    
23.         'Split ¨ç¼Æ: ¶Ç¦^¤@­Ó³¯¦C¯Á¤Þ±q¹s¶}©lªº¤@ºû°}¦C¡A¥¦¥]§t«ü©w¼Æ¥Øªº¤l¦r¦ê¡C
    
24.     End If
    
25. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 8# emma

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     Dim Target_Row As String, xi As Integer, xi_Row As String
   
3.     If Not Application.Intersect(Range("A4", Range("A4").End(xlDown)), Target) Is Nothing Then
   
4.         'Intersectª«¥ó
   
5.         Target_Row = ²Ä¤@Äæ & "," & ²Ä¤TÄæ & "," & ²Ä¤­Äæ    '³o¸Ì¦Û¦æ­×§ï ³s±µ¤£³sÄò¦ì¸m
   
6.         xi = 7
   
7.         Do While Sheets("sheet2").Cells(xi, 1) <> ""
   
8.            xi_Row = Join(Application.Transpose(Application.Transpose(Sheets("sheet2").Cells(xi, 1).Resize(, 3))), ",")
   
9.            If xi_Row = Target_Row Then Exit Sub
   
10.            xi = xi + 1
    
11.         Loop
    
12.         Sheets("sheet2").Cells(xi, 1).Resize(, 3) = Split(Target_Row, ",")
    
13.         'Split ¨ç¼Æ: ¶Ç¦^¤@­Ó³¯¦C¯Á¤Þ±q¹s¶}©lªº¤@ºû°}¦C¡A¥¦¥]§t«ü©w¼Æ¥Øªº¤l¦r¦ê¡C
    
14.     End If
    
15. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 11# emma
¸Õ¸Õ¬Ý

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)    '¤¹³\¦P¤@µ§¸ê®ÆµL­­¦¸¼Æ¥i¥HÂI¤@¦¸AÄæ¬YÀx¦s®æ´N¥X²{¦ÜSheet2¤@¦¸
   
2.     Dim Target_Row As String
   
3.     If Not Application.Intersect(Range("A4", Range("A4").End(xlDown)), Target) Is Nothing Then
   
4.        'Intersectª«¥ó:  Target¥]§t¦bRange("A4", Range("A4").End(xlDown))*** ¤~­n°õ¦æ ***
   
5.         Target_Row = Target(, 1) & "," & Target(, 3) & "," & Target(, 5)    '³o¸Ì¦Û¦æ­×§ï ³s±µ¤£³sÄò¦ì¸m
   
6.        Sheets("sheet2").Range("a" & Rows.Count).End(xlUp).Offset(1).Resize(, 3) = Split(Target_Row, ",")
   
7.         'Split ¨ç¼Æ: ¶Ç¦^¤@­Ó³¯¦C¯Á¤Þ±q¹s¶}©lªº¤@ºû°}¦C¡A¥¦¥]§t«ü©w¼Æ¥Øªº¤l¦r¦ê¡C
   
8.     End If
   
9. End Sub
   
10. Sub Ex()  'ªG¨Ï¥ÎªÌ¤£¤p¤ßÂI¿ù:­è­èÂI¿ù ©Î §R¥þ³¡
    
11.     Dim Target_Row As String, xi As Integer
    
12.     If Not Application.Intersect(Range("A4", Range("A4").End(xlDown)), ActiveCell) Is Nothing Then
    
13.         Target_Row = ActiveCell & "," & ActiveCell(, 3) & "," & ActiveCell(, 5)    '³o¸Ì¦Û¦æ­×§ï ³s±µ¤£³sÄò¦ì¸m
    
14.         With Sheets("sheet2")
    
15.             xi = .Range("a" & Rows.Count).End(xlUp).Row
    
16.             Do While xi > 7
    
17.                 If .Cells(xi, 1) & "," & .Cells(xi, 2) & "," & .Cells(xi, 3) = Target_Row Then
    
18.                     .Cells(xi, 1).Resize(, 3).Delete xlUp
    
19.                     Exit Sub  '­è­èÂI¿ù ¥u§R¤@¦¸  ***±N¦¹¦¨¦æµù¸Ñ±¼ ¥i§R¥þ³¡
    
20.                 End If
    
21.                 xi = xi - 1
    
22.             Loop
    
23.        End With
    
24.     End If
    
25. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 13# emma
Àx¦s®æ®Ç¥X²{¡u!¡v                                                                                                         ¨º¬O¿ù»~Àˬdªº´£¥Ü¥\¯àªí,¥i¹î¬Ý¤u¨ã->¿ï¶µ ->¿ù»~Àˬd
Sub Ex()  '¦pªG¨Ï¥ÎªÌ¤£¤p¤ßÂI¿ù:­è­èÂI¿ù ©Î §R¥þ³¡¡A³o¬q´N§¹¥þ¨S¦³¤ÏÀ³¡A Ex() ³oµ{¦¡ ¤£·| ¦Û°Ê°õ¦æªº.¥¦¤£¬O¤u§@ªíªºÄ²°Ê¨Æ¥ó

1. Option Explicit
   
2. Private Sub Worksheet_Change(ByVal Target As Range)             '***¥¦¬O¤u§@ªíªºÄ²°Ê¨Æ¥ó ***
   
3.     Dim Target_Row As String
   
4.     If Target.Address(0, 0) = "D1" Then
   
5.         Range("F3").AutoFilter Field:=6, Criteria1:="*" & Target & "*"
   
6.     ElseIf Target.Address(0, 0) = "B1" Then
   
7.         Range("B3").AutoFilter Field:=2, Criteria1:="*" & Target & "*"
   
8.     ElseIf Not Application.Intersect(Range("b4", Range("b4").End(xlDown)).Offset(, -1), Target) Is Nothing Then
   
9.         Target_Row = Target(, 2) & "," & Target(, 3) & "," & Target(, 4) & "," & Target(, 5) & "," & Target(, 6)
   
10.         §ïÅܨϥΪº¤è¦¡ Target.Value, Target_Row
    
11.     End If
    
12. End Sub
    
13. Private Sub §ïÅܨϥΪº¤è¦¡(¶Ç°e¦¸¼Æ As Integer, ±µ¦¬¦r¦ê As String)
    
14.     Dim xi  As Integer, xi_¦¸¼Æ As Integer, xi_¦r¦ê, Rng As Range
    
15.     With Sheet2
    
16.         xi = 7
    
17.         Do While .Cells(xi, 1) <> ""
    
18.             xi_¦r¦ê = Join(Application.Transpose(Application.Transpose(.Cells(xi, 1).Resize(, 5))), ",")
    
19.             If xi_¦r¦ê = ±µ¦¬¦r¦ê Then
    
20.                 If xi_¦¸¼Æ < ¶Ç°e¦¸¼Æ Then
    
21.                     xi_¦¸¼Æ = xi_¦¸¼Æ + 1
    
22.                 ElseIf xi_¦¸¼Æ = ¶Ç°e¦¸¼Æ Then
    
23.                     If Rng Is Nothing Then Set Rng = .Cells(xi, 1) Else Set Rng = Union(Rng, .Cells(xi, 1))
    
24.                 End If
    
25.             End If
    
26.             xi = xi + 1
    
27.         Loop
    
28.         If xi_¦¸¼Æ < ¶Ç°e¦¸¼Æ Then
    
29.             For xi = xi To xi + ¶Ç°e¦¸¼Æ - xi_¦¸¼Æ - 1
    
30.                 .Cells(xi, 1).Resize(, 5) = Split(±µ¦¬¦r¦ê, ",")
    
31.             Next
    
32.             .Range("A6").CurrentRegion.Sort Key1:=.Range("A7"), Order1:=xlAscending, Key2:=.Range( _
    
33.                         "B7"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase _
    
34.                         :=False, Orientation:=xlTopToBottom, SortMethod:=xlStroke, DataOption1:= _
    
35.                         xlSortNormal, DataOption2:=xlSortNormal
    
36.         ElseIf Not Rng Is Nothing Then
    
37.             Rng.EntireRow.Delete
    
38.         End If
    
39.     End With
    
40. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 17# emma
­×§ï¦p¤U Targetªº²Ä¤@­ÓCells(1)

1. Target_Row = Target(, 2) & "," & Target(, 3) & "," & Target(, 4) & "," & Target(, 5) & "," & Target(, 6)
   
2. §ïÅܨϥΪº¤è¦¡ Target.Cells(1).Value, Target_Row

½Æ»s¥N½X

¦]¬°Sheet1.UsedRange..Range("B4:B60300").Clear ªº½d³ò ¾É­P
Private Sub Worksheet_Change(ByVal Target As Range)     
¶Ç¦^ Target<=>.Range("B4:B60300") ¤£¬O³æ¤@ªºÀx¦s®æ

§ïÅܨϥΪº¤è¦¡  Target.Value ¬O±µ¦¬³æ¤@ªº­È **©Ò¥H«¬ºA¤£¦P

GBKEE

¦^´_ 19# emma
³o°ÝÃD§A¸Õ¸Õ´Nª¾¹D

GBKEE

¦^´_ 24# emma

1. If Not Application.Intersect(Range("A2", Range("A2").End(xlDown)), Target) Is Nothing Then
   
2. '§ï¦¨ B2 -[B2].End(xlDown) ¶¡¸ê®Æ¦C¦V¥ª¦ì²¾¤@Äæ (AÄæ)  
   
3. If Not Application.Intersect(Range("B2", Range("B2").End(xlDown).Offset(, -1)), Target) Is Nothing Then

½Æ»s¥N½X

23#
¹Ï1»P¹Ï2¬Û¹ïÀ³ªº¸ê®Æ[§»¥þ]¬°¦ó·|¬O2µ§¸ê®Æ
²Ö¿nÂI¼Æ,¬¡°Êª¬ºA ¨âÄæ ¬O¦p¦ó§PÂ_!!

GBKEE

¦^´_ 34# emma

1. Option Explicit
   
2. Private Sub Worksheet_Change(ByVal Target As Range)
   
3.     Dim Target_Row As String, s As Integer, dot As Long, k As Integer, m As String
   
4.     Dim Ar(), A As Range
   
5.     If Target.Address(0, 0) = "E1" Then
   
6.         Range("D3").AutoFilter Field:=2, Criteria1:="*" & Target & "*"
   
7.     ElseIf Target.Address(0, 0) = "C1" Then
   
8.         Range("C3").AutoFilter Field:=1, Criteria1:="*" & Target & "*"
   
9.     End If
   
10.     With Sheet1
    
11.         If Application.Count(.Range("B:B")) > 0 Then
    
12.             For Each A In .Range("B:B").SpecialCells(xlCellTypeConstants, 1)
    
13.                 ReDim Preserve Ar(s)
    
14.                 If A.Offset(, 8) = "V" And A.Offset(, 9) >= Date And A > A.Offset(, 4) Then dot = Int(A / 1000) * 1000 Else dot = 0
    
15.                 k = IIf(Sheets("¬d¸ß").[B1] = "Á`©±", 10, 11)
    
16.                 If A.Offset(, 7) < Date Then
    
17.                     m = "¤wµ²§ô"
    
18.                 ElseIf A < A.Offset(, 4) Then
    
19.                     m = "¹B¶O+¤âÄò¶O"
    
20.                 ElseIf InStr(A.Offset(, 5), "±À") And A > A.Offset(, 4) Then       '¥]§t
    
21.                     m = "§K¹B"
    
22.                 ElseIf InStr(A.Offset(, 5), "±À") = 0 And A > A.Offset(, 4) Then   '¤£¥]§t
    
23.                     m = "¹B¶O"
    
24.                 End If
    
25.                 Ar(s) = Array(A.Offset(, 2).Value, A.Value, A.Offset(, 3).Value, dot, A.Offset(, 12).Value, A.Offset(, k).Value, m, A.Offset(, 6).Value)
    
26.                 s = s + 1
    
27.             Next
    
28.         End If
    
29.     End With
    
30.     With Sheets("¬d¸ß")
    
31.         If s > 0 Then
    
32.             Target = ""
    
33.             .Range("A" & .Rows.Count).End(xlUp).Offset(1).Resize(s, 8) = Application.Transpose(Application.Transpose(Ar))
    
34.             .Range("A4").CurrentRegion.Sort key1:=.[A4], Header:=xlYes
    
35.         End If
    
36.     End With
    
37. End Sub

½Æ»s¥N½X