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

¦^´_ 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

¦^´_ 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

¦^´_ 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

¦^´_ 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

¦^´_ 45# emma
­n«O¦³­ì¨Óªº¥\¯à¨º Private Sub Worksheet_Change(ByVal Target As Range)
³oµ{§ÇÁÙ¬O­n¨Ì·Ó42# ªºµ{¦¡½X , ¦ý»Ý§R±¼³o09, 10 ¨â¦æªºµ{¦¡½X.(¥H«eªºµ{¦¡·|§ì¨úBÄæ©Ò¦³ªº¼Æ¦r¸ê®Æ)

1. 09.    Else
   
2. 10.        Exit Sub                                  '*****

½Æ»s¥N½X

1. 13.    Set Rng = Range("B4:B65536").SpecialCells(xlCellTypeVisible)     '¦Û°Ê¿z¿ï«á¥i¨£ªºÀx¦s®æ
   
2.        '13:§ì¨ú  C1 ,E1 ¦Û°Ê¿z¿ï ªº½d³ò
   
3. 14.    If Application.Count(Rng) > 0 Then                                                      '¥i¨£ªºÀx¦s®æ:¦³¸ê®ÆÀx¦s®æªºÁ`¼Æ>0
   
4. 15.        Set Rng = Rng.SpecialCells(xlCellTypeConstants)                         '¥i¨£ªºÀx¦s®æ:¦³¸ê®ÆªºÀx¦s®æ

½Æ»s¥N½X

emma

¦^´_ 46# GBKEE

   GBKEEª©¤j¡Aªì´Á¨â­Ó´ú¸Õ¤U¨Ó¦ü¥G¨S¦³¤°»ò¤£¤@¼Ë¡A¦]¬°·í¿é¤J§¹¼Æ¶q«á¡ABÄæ´N·|¦Û°Ê²MªÅ¡A¤£·|¯d­È¦b­ìÀx¦s®æ¤W¡A
³o¼Ëªº¸Ü¡A45#¸ò46#ªº®t²§¬O¦]¬°"¥H«eªºµ{¦¡·|§ì¨úBÄæ©Ò¦³ªº¼Æ¦r¸ê®Æ"¡A©Ò¥H45#·|¦³¤£½T©w¦]¯À¾É­P§PÂ_¥¢±`¶Ü?
¬Ý¨Ó§ÚÁÙ¦³«Ü¦h»Ý­n¥h§l¦¬®ø¤Æªº¡A¦p¤£¬O±zªº´£ÂI¡A§Ú¤£·|¹îı45#¦³¤°»ò°ÝÃD¡AÁÂÁ±z­@¤ßªº«ü¾É^^

PS.§Ú¬O¸ÕµÛ§â¡uTarget = ""¡v®³±¼¡A¨º´N¯uªº®t«Ü¦h¤F~~¤£¬O«Ü²M·¡¬°¤°»ò45#§âTarget = ""®³±¼·|°õ¦æ¥X³o¼Ëªºµ²ªG

1.   If s > 0 Then
   
2.             Target = ""

½Æ»s¥N½X

¤U¸ü (58.68 KB)

2012-12-19 15:09

¤U¸ü (37.26 KB)

2012-12-19 15:09

¤U¸ü (101.92 KB)

2012-12-19 15:09

¤U¸ü (108.25 KB)

2012-12-19 15:09

GBKEE

¦^´_ 47# emma
¹ï©óÆ[¬Ýµ{¦¡°õ¦æ¹Lµ{: ¥i¦b VBAµøµ¡¤¤,±N·Æ¹«ÂI¦bµ{¦¡½Xªº½d³ò¤º,«ö¤UF8 ³v¨B°õ¦æ
¦p¦P¹Ï¥Ü:¦b¤u§@ªíµøµ¡¤¤

¤U¸ü (23.53 KB)

2012-12-19 16:33

emma

¦^´_ 48# GBKEE

GBKEEª©¤j¡A±z¦n
·Q§Q¥Î¡i¬d¸ß¡j¤u§@ªí¦A·J¾ã¦Ü¡i¥¼¥X³f²M³æ¡jªº¤u§@ªí¡A¦ý¤£¾å±o¸Ó¦p¦ó³]©w¤~¦n¡A©Ò¥H¤S¨Ó¦V±z½Ð±Ð¡A
¦pªþ¥ó¡A¡i¬d¸ß¡j¤u§@ªí¤¤§ÀÄæ¦h¤F¤@Äæ¡i¥X³fª¬ªp¡jªºÄæ¦ì¡A¤@¯ë¹w³]¡i¥X³fª¬ªp¡j¬°¡u¥¼¥X³f¡v¡A¦ý¦b¦³²{³fªºª¬ªp¤U¡A¥i¥Ñ¤H­û¦Û¦æ§ï¬°¡u¤w¥X³f¡v
»Ý¦C¦L¡u¥¼¥X³f©ú²Ó¡v©Ò¥H¥i§_«ö¡u¥¼¥X³f©ú²Ó¡vªº«ö¶s¡A±N¡i¥X³fª¬ªp¡j¬°¡u¤w¥X³f¡v¤Î¡i¬¡°Êª¬ºA¡j¬°¡u¤wµ²§ô¡vªº¶µ¥Ø¦©°£«á¡A
±N¨ä¾l¡u¥¼¥X³f¡vªº¦X¨Ö¦Ü¡u¥¼¥X³f²M³æ¡v¤u§@ªí¤¤?µ²ªG¦pªþ¥ó¤¤¡i¥¼¥X³f²M³æ¡jªº¤u§@ªíªº¼Ë¤l(¬O§Ú¤â°Ê¦Û¤v§ï¦¨­n§e²{ªºµ²ªG)


    VBAtest12.rar (22.29 KB)

¤U¸ü¦¸¼Æ: 6

2012-12-26 14:58

GBKEE

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


11.zip (31.37 KB)

¤U¸ü¦¸¼Æ: 7

2012-12-27 08:41