emma

¦^´_ 44# GBKEE

    GBKEEª©¤j¡A¯uªº«D±`ªº·PÁ±z¡A§Ú¥Ø«e·Q­n«O¦³­ì¦³ªº¥\¯à¦A¥[¤W¥i¥H¬d¸ß¥XÀx¦ì¡A©Ò¥H¨ä¹ê¥u­n§âÀx¦ìªº¨º¦C
©ñ¶i­ì¥»ªºµ{¦¡¤¤°õ¦æ´N¥i¥H¤F¡A¥u¬O§Ú¤£¾å±o¡õ³o¥yªº»yªk­n«ç»ò¥Î¤~¹ï¡A©Ò¥H¦V±z´£°Ý¡A¥t¥~¡A±z©Ò´£¨Ñªº¦UºØ¤è¦¡¡A
§Ú³£·Q­n¸Õ¸Õ¡A§Y«K¬O²{¦b¤£·|±Ä¥Î¡A¦ý¦p±z©Ò¨¥¡Aµ{¦¡­n¦h§l¦¬¤~·|¶i¨B¡A«D±`·PÁ±zªº¸Ñ´b^^

1. Sheets("¸ê®ÆÀÉ").[C2] = .Range("A" & .Rows.Count).End(xlUp).Offset(, 5)

½Æ»s¥N½X

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. [color=Red]             Sheets("¸ê®ÆÀÉ").[C2] = .Range("A" & .Rows.Count).End(xlUp).Offset(, 5)   'FÄæ:Àx¦ì[/color]
    
36.         End If
    
37.     End With
    
38. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 43# emma
****  µ{¦¡½X ­n§l¦¬ ¤~·|¶i¨B  ***
Private Sub Worksheet_Change(ByVal Target As Range)  
¬O"¸ê®ÆÀÉ"³o¤u§@ªí ªºÀx¦s®æ¦³­×§ï«á,·|°õ¦æªºµ{§Ç(¨t²Î¹w³]ªº¤u§@ªí¨Æ¥ó: Target ->¦³­×§ï«áªºÀx¦s®æ  )

1. If Target.Address(0, 0) = "E1" Then
   
2.         Range("D3").AutoFilter Field:=2, Criteria1:="*" & Target & "*"
   
3.     ElseIf Target.Address(0, 0) = "C1" Then
   
4.         Range("C3").AutoFilter Field:=1, Criteria1:="*" & Target & "*"
   
5.     Else
   
6.         Exit Sub                                  '*****
   
7.     End If

½Æ»s¥N½X

³o¥¨¶° ³]­p¬°¦b E1 ©Î¬O C1   ¦³­×§ï«á,¤~·|°õ¦æ
§A¦bBÄ榳­×§ï«á µ{¦¡·| Exit Sub    (Â÷¶}µ{§Ç :¤£°õ¦æ¤F)      ¹F¤£¨ì§Aªº´Á±æ                         '*****
§A­n·íBÄæ¼Æ¶q¦³¿é¤J­n¶Ç°e¨ì[¬d¸ß] ¸Ì ¨º·|³y¦¨¸ê®Æµ§¼Æªº¿ù¶Ã   ©Ò¥H¤~³]­p Exit Sub
¥t¤@¤èªk:
²{¦b ½Ð¤£­n¥ÎPrivate Sub Worksheet_Change(ByVal Target As Range) (§R±¼¥¦)
¦A³]¤@«ö¶s «ü©w°õ¦æ¥¨¶°: ¼Æ¶q¬d¸ß
·í§AªºE1 , C1 ©Î¬O  BÄæ¼Æ¶q ­×§ï§¹¦¨«á ½T©w«ö[«ö¶s]  ¶Ç°e¨ì[¬d¸ß]

1. Sub ¼Æ¶q¬d¸ß()  '³oµ{§Ç»Ý½Æ»s¨ì [¸ê®ÆÀÉ]ªº¼Ò²Õ¤¤
   
2.     Dim Target_Row As String, s As Integer, dot As Long, k As Integer, m As String
   
3.     Dim Ar(), A As Range, Rng As Range
   
4.     Range("D3").AutoFilter Field:=2, Criteria1:="*" & [C1] & "*"
   
5.     Range("C3").AutoFilter Field:=1, Criteria1:="*" & [E1] & "*"
   
6.     Set Rng = Sheets("¸ê®ÆÀÉ").Range("B4:B65536").SpecialCells(xlCellTypeVisible)     '¦Û°Ê¿z¿ï«á¥i¨£ªºÀx¦s®æ
   
7.     If Application.Count(Rng) > 0 Then                                                      '¥i¨£ªºÀx¦s®æ:¦³¸ê®ÆÀx¦s®æªºÁ`¼Æ>0
   
8.         Set Rng = Rng.SpecialCells(xlCellTypeConstants)                         '¥i¨£ªºÀx¦s®æ:¦³¸ê®ÆªºÀx¦s®æ
   
9.             For Each A In Rng.Cells
   
10.                 ReDim Preserve Ar(s)
    
11.                 If A.Offset(, 8) = "V" And A.Offset(, 9) >= Date And A > A.Offset(, 4) Then dot = Int(A / 1000) * 1000 Else dot = 0
    
12.                 k = IIf(Sheets("¬d¸ß").[B1] = "Á`©±", 10, 11)
    
13.                 If A.Offset(, 7) < Date Then
    
14.                     m = "¤wµ²§ô"
    
15.                 ElseIf A < A.Offset(, 4) Then
    
16.                     m = "¹B¶O+¤âÄò¶O"
    
17.                 ElseIf InStr(A.Offset(, 5), "±À") And A > A.Offset(, 4) Then       '¥]§t
    
18.                     m = "§K¹B"
    
19.                 ElseIf InStr(A.Offset(, 5), "±À") = 0 And A > A.Offset(, 4) Then   '¤£¥]§t
    
20.                     m = "¹B¶O"
    
21.                 End If
    
22.                 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)
    
23.                 s = s + 1
    
24.             Next
    
25.     End If
    
26.     With Sheets("¬d¸ß")
    
27.         If s > 0 Then
    
28.             .Range("A" & .Rows.Count).End(xlUp).Offset(1).Resize(s, 8) = Application.Transpose(Application.Transpose(Ar))
    
29.             Sheets("¸ê®ÆÀÉ").[C2] = .Range("A" & .Rows.Count).End(xlUp).Offset(, 5)   'FÄæ:Àx¦ì
    
30.         End If
    
31.     End With
    
32. End Sub

½Æ»s¥N½X

emma

¦^´_ 42# GBKEE


    ÁÂÁÂGBKEEª©¤j¡A¦b´ú¸Õªº¹Lµ{¤¤¡AÁÙ¬OµLªk¶¶§Q·s¼W¦Ü¬d¸ß¸Ì¡A¤£¾å±o¬O­þ¸Ì¥X¤F°ÝÃD¡A
    «á¨Óµo²{¦b¿é¤J§¹¼Æ¶q«á¡A­n«ö¤@¤U¡u¸ê®ÆÀÉ¡v¤¤ªº¡u­«¶ñ¼Æ¶q¡v«ö¶s¡A¤~¯à¶¶§Q·s¼W¦Ü¡u¬d¸ß¡v¤u§@ªí¤¤¡A
    §Ú¦b¦Û¦æ¬ã¨s¤@¤UÃöÁp©Ê¡AÁÂÁ±zªºÀ°¦£~~~

¤U¸ü (86.92 KB)

2012-12-19 11:54

VBAtest11.rar (19.48 KB)

¤U¸ü¦¸¼Æ: 4

2012-12-19 11:57

GBKEE

¦^´_ 41# 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, Rng 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.     Else
   
10.         Exit Sub                                  '*****
    
11.     End If
    
12.     Application.EnableEvents = False              '****
    
13.     Set Rng = Range("B4:B65536").SpecialCells(xlCellTypeVisible)     '¦Û°Ê¿z¿ï«á¥i¨£ªºÀx¦s®æ
    
14.     If Application.Count(Rng) > 0 Then                                                      '¥i¨£ªºÀx¦s®æ:¦³¸ê®ÆÀx¦s®æªºÁ`¼Æ>0
    
15.         Set Rng = Rng.SpecialCells(xlCellTypeConstants)                         '¥i¨£ªºÀx¦s®æ:¦³¸ê®ÆªºÀx¦s®æ
    
16.             For Each A In Rng.Cells
    
17.                 ReDim Preserve Ar(s)
    
18.                 If A.Offset(, 8) = "V" And A.Offset(, 9) >= Date And A > A.Offset(, 4) Then dot = Int(A / 1000) * 1000 Else dot = 0
    
19.                 k = IIf(Sheets("¬d¸ß").[B1] = "Á`©±", 10, 11)
    
20.                 If A.Offset(, 7) < Date Then
    
21.                     m = "¤wµ²§ô"
    
22.                 ElseIf A < A.Offset(, 4) Then
    
23.                     m = "¹B¶O+¤âÄò¶O"
    
24.                 ElseIf InStr(A.Offset(, 5), "±À") And A > A.Offset(, 4) Then       '¥]§t
    
25.                     m = "§K¹B"
    
26.                 ElseIf InStr(A.Offset(, 5), "±À") = 0 And A > A.Offset(, 4) Then   '¤£¥]§t
    
27.                     m = "¹B¶O"
    
28.                 End If
    
29.                 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)
    
30.                 s = s + 1
    
31.             Next
    
32.     End If
    
33.     With Sheets("¬d¸ß")
    
34.         If s > 0 Then
    
35.             Target = ""
    
36.             .Range("A" & .Rows.Count).End(xlUp).Offset(1).Resize(s, 8) = Application.Transpose(Application.Transpose(Ar))
    
37.             Sheets("¸ê®ÆÀÉ").[C2] = .Range("A" & .Rows.Count).End(xlUp).Offset(, 5)   'FÄæ:Àx¦ì
    
38.         End If
    
39.     End With
    
40.     Application.EnableEvents = True                 '*******
    
41. End Sub

½Æ»s¥N½X

emma

¦^´_ 40# GBKEE


    GBKEEª©¥D¡A¥u¦³²Ä¤@µ§¥i¥H¡A¦ý¤§«áªº´N¤S¨S§@¥Î¤F­C¡A³s¿z¿ï¤]°Ê¤£¤F(¦p¹Ï¤G)
   

¤U¸ü (73.13 KB)

2012-12-18 17:29

   

¤U¸ü (121.45 KB)

2012-12-18 17:29

GBKEE

¦^´_ 39# emma
¿é¤J: «H
¨ì[¬d¸ß]¬Ý¬Ý

¤U¸ü (41.85 KB)

2012-12-18 17:01

emma

¦^´_ 38# GBKEE

  GBKEEª©¥D¡A¸Õ¤F¡A¦ý¬O¨S¤ÏÀ³¡A³s­ì¥ýªº¥\¯à¤]¤£¨£¤F¡A«ç»ò·|³o¼Ë©O??
    VBAtest11.rar (19.08 KB)

¤U¸ü¦¸¼Æ: 7

2012-12-18 16:30

GBKEE

¦^´_ 37# 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.     Application.EnableEvents = False              '****
   
6.     If Target.Address(0, 0) = "E1" Then
   
7.         Range("D3").AutoFilter Field:=2, Criteria1:="*" & Target & "*"
   
8.     ElseIf Target.Address(0, 0) = "C1" Then
   
9.         Range("C3").AutoFilter Field:=1, Criteria1:="*" & Target & "*"
   
10.     Else
    
11.         Exit Sub                                  '*****
    
12.     End If
    
13.     With Sheet1
    
14.         If Application.Count(.Range("B:B")) > 0 Then
    
15.             For Each A In .Range("B:B").SpecialCells(xlCellTypeConstants, 1)
    
16.                 ReDim Preserve Ar(s)
    
17.                 If A.Offset(, 8) = "V" And A.Offset(, 9) >= Date And A > A.Offset(, 4) Then dot = Int(A / 1000) * 1000 Else dot = 0
    
18.                 k = IIf(Sheets("¬d¸ß").[B1] = "Á`©±", 10, 11)
    
19.                 If A.Offset(, 7) < Date Then
    
20.                     m = "¤wµ²§ô"
    
21.                 ElseIf A < A.Offset(, 4) Then
    
22.                     m = "¹B¶O+¤âÄò¶O"
    
23.                 ElseIf InStr(A.Offset(, 5), "±À") And A > A.Offset(, 4) Then       '¥]§t
    
24.                     m = "§K¹B"
    
25.                 ElseIf InStr(A.Offset(, 5), "±À") = 0 And A > A.Offset(, 4) Then   '¤£¥]§t
    
26.                     m = "¹B¶O"
    
27.                 End If
    
28.                 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)
    
29.                 s = s + 1
    
30.             Next
    
31.         End If
    
32.     End With
    
33.     With Sheets("¬d¸ß")
    
34.         If s > 0 Then
    
35.             Target = ""
    
36.             .Range("A" & .Rows.Count).End(xlUp).Offset(1).Resize(s, 8) = Application.Transpose(Application.Transpose(Ar))
    
37.             Sheets("¸ê®ÆÀÉ").[C2] = .Range("A" & .Rows.Count).End(xlUp).Offset(, 5)   'FÄæ:Àx¦ì
    
38.         End If
    
39.     End With
    
40.     Application.EnableEvents = True                 '*******
    
41. End Sub

½Æ»s¥N½X

emma

¦^´_ 35# GBKEE


    GBKEEª©¤j¡A¤£¦n·N«ä¡A·Q¦A¦V±z½Ð±Ð¤@¤U¡A¦p·QÅý¡u¸ê®ÆÀÉ¡v¤u§@ªíªºC2Åã¥Ü³Ì«á¤@µ§¨Ï¥ÎªÌ¿é¤JªºÀx¦ì¡AÀ³¸Ó­n«ç»ò°µ©O?
    §Ú¸Õ¤FSheets("¸ê®ÆÀÉ").[C2] = A.Offset(, k).Value¡A¦ý·|Åã¥Ü¡u¨S¦³³]©wª«¥óÅܼƩÎwith°Ï¶ôÅܼơv¬°¤°»ò©O?
    ³Â·Ð±z¤F¡AÁÂÁÂ^^
VBAtest11.rar (19.24 KB)

¤U¸ü¦¸¼Æ: 5

2012-12-18 14:37

emma

¦^´_ 35# GBKEE


    GBKEEª©¤jÁÂÁ±z¡AÁÙ¦³¤@­Ó·sªº·Qªk¡A¦ý³o¤@­Ó¥\¯àªº¥i¯à©Ê¤£¾å±o¯à¤£¯à°µ¨ì¡A¦pªG¨Ï¥ÎªÌ¦b¼Æ¶qªºÄæ¦ìKEY¬Y­ÓÃöÁä¦r¡A¦pKEY"0"©Î«D¼Æ¦r¨Ò"ABC"³oºØ¥N¸¹ªº¸Ü¡A´N¥t¥~¸õ¥X¤@­Ó¿é¤J¼Æ¶qªºµøµ¡¡AÅý¨Ï¥ÎªÌKEY¤J¼Æ¶q¡A¥Øªº¬O¬°¤F¬Y¨Ç¯S®íªº±¡§Î­nÁ׶}­pºâ¡u§K¹B¡vªº³¡¥÷¡AµL½×¸Ó¶µ²£«~¥»¨­¬O§_¦³²Å¦X¡u§K¹B¡vªº±ø¥ó¡A¥u­n¥Î³o­Ó¤è¦¡¿é¤J¼Æ¶qªº¸Ü¡A´N¬O¤£¥h§PÂ_§K¹Bªº³¡¥÷¡A¥u·|¦³¡u¤wµ²§ô¡v¡B¡u¹B¶O¡v¡B¡u¹B¶O+¤âÄò¶O¡v³o¤TºØ§PÂ_¦Ó¥H¡C

§Æ±æ¯àÀò±o¸Ñ´b¡AÁÂÁÂ!!