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

GBKEE

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

¤U¸ü (41.85 KB)

2012-12-18 17:01

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

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

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

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

GBKEE

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


11.zip (31.37 KB)

¤U¸ü¦¸¼Æ: 7

2012-12-27 08:41

GBKEE

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

test.rar (31.47 KB)

¤U¸ü¦¸¼Æ: 9

2013-1-2 17:41

GBKEE

¦^´_ 53# 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, t As String
   
4.     Dim Ar(), A As Range, Rng As Range
   
5.     If Target.Address(0, 0) = "E1" Then
   
6.         Range("D3").AutoFilter Field:=4, Criteria1:="*" & Target & "*"
   
7.     ElseIf Target.Address(0, 0) = "C1" Then
   
8.         Range("C3").AutoFilter Field:=3, Criteria1:="*" & Target & "*"
   
9.     End If
   
10.     Application.EnableEvents = False              '****
    
11.     Set Rng = Range("B4:B65536").SpecialCells(xlCellTypeVisible)     '¦Û°Ê¿z¿ï«á¥i¨£ªºÀx¦s®æ
    
12.     If Application.Count(Rng) > 0 Then                                                      '¥i¨£ªºÀx¦s®æ:¦³¸ê®ÆÀx¦s®æªºÁ`¼Æ>0
    
13.         Set Rng = Rng.SpecialCells(xlCellTypeConstants)                         '¥i¨£ªºÀx¦s®æ:¦³¸ê®ÆªºÀx¦s®æ
    
14.             For Each A In Rng.Cells
    
15.              ReDim Preserve Ar(s)
    
16.                 If A.Offset(, 8) = "V" And A.Offset(, 9) >= Date And A > A.Offset(, 4) Then dot = Int(A / 1000) * 1000 Else dot = 0
    
17.                 K = IIf(Sheets("¬d¸ß").[b1] = "Á`©±", 10, 11)
    
18.                 If A.Offset(, 7) < Date Then
    
19.                     M = "¤wµ²§ô"
    
20.                     t = "¤w¥X³f"
    
21.                 ElseIf A < A.Offset(, 4) Then
    
22.                     M = "¹B¶O+¤âÄò¶O"
    
23.                     t = "¥¼¥X³f"
    
24.                 ElseIf InStr(A.Offset(, 5), "±À") And A > A.Offset(, 4) Then       '¥]§t
    
25.                     M = "§K¹B"
    
26.                     t = "¥¼¥X³f"
    
27.                 ElseIf InStr(A.Offset(, 5), "±À") = 0 And A > A.Offset(, 4) Then   '¤£¥]§t
    
28.                     M = "¹B¶O"
    
29.                     t = "¥¼¥X³f"
    
30.                 End If
    
31.                 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, A.Offset(, 7).Value, t)
    
32.                 s = s + 1
    
33.             Next
    
34.             With UserForm2
    
35.                 .TextBox1 = Ar(s - 1)(0)
    
36.                 .TextBox2 = dot
    
37.                 .TextBox3 = M
    
38.                 .Show
    
39.             End With
    
40.         End If
    
41.     With Sheets("¬d¸ß")
    
42.         If s > 0 And UserForm2.Msg = False Then
    
43.             Target = ""
    
44.             .Range("A" & .Rows.Count).End(xlUp).Offset(1).Resize(s, 10) = Application.Transpose(Application.Transpose(Ar))
    
45.             .Range("A4").CurrentRegion.Sort Key1:=.[A4], Header:=xlYes
    
46.              Sheets("¸ê®ÆÀÉ").[C2] = .Range("A" & .Rows.Count).End(xlUp).Offset(, 5)   'FÄæ:Àx¦ì
    
47.         End If
    
48.     End With
    
49.     Application.EnableEvents = True                 '*******
    
50. End Sub

½Æ»s¥N½X

1. Public Msg As Boolean   '«ö¤U [¨ú®ø] ªº¤½¥ÎÅܼÆ
   
2. Private Sub CommandButton1_Click()
   
3.     UserForm2.Hide
   
4. End Sub
   
5. 'UserForm2 ¶·¼W¥[¤@CommandButton2  '¨ú®ø«ö¶s
   
6. Private Sub CommandButton2_Click()  
   
7.     Msg = True                               ''«ö¤U [¨ú®ø] «ö¶s¬° True
   
8.     UserForm2.Hide
   
9. End Sub
   
10. Private Sub UserForm_Activate()  'UserForm Åã¥Ü®É
    
11.       Msg = False                '¨ú®ø [¨ú®ø]«ö¶s
    
12. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 55# emma

1.             With Cells(Rows.Count, Columns.Count)
   
2.                 .Value = dot
   
3.                 .NumberFormatLocal = "[DBNum1][$-404]G/³q¥Î®æ¦¡" '¤p¼g°ê¦r
   
4.                 '.NumberFormatLocal = "[DBNum2][$-404]G/³q¥Î®æ¦¡" '¤j¼g°ê¦r
   
5.                 '.NumberFormatLocal = "#,##0_);[¬õ¦â](#,##0)"     '¤d¤À¦ì
   
6.             End With
   
7.             With UserForm2
   
8.                 .TextBox1 = Ar(s - 1)(0)
   
9.                 .TextBox2 = Cells(Rows.Count, Columns.Count).Text
   
10.                 .TextBox3 = M
    
11.                 .Show
    
12.             End With

½Æ»s¥N½X