ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ¿z¿ï?ÃöÁä¦r?¬d¸ß?

¦^´_ 40# GBKEE


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

TOP

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

TOP

¦^´_ 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ªºÀ°¦£~~~

123.gif
VBAtest11.rar (19.48 KB)

TOP

¥»©«³Ì«á¥Ñ GBKEE ©ó 2012-12-19 12:54 ½s¿è

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

TOP

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

TOP

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

TOP

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



TOP

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


TOP

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

TOP

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


11.zip (31.37 KB)

TOP

        ÀR«ä¦Û¦b : ¤Hªº¤ß¦a¬O¤@²¥¥Ð¡A¤g¦a¨S¦³¼½¤U¦nºØ¤l¡A¤]ªø¤£¥X¦nªºªG¹ê¡C -
ªð¦^¦Cªí ¤W¤@¥DÃD