Hsieh

¦^´_ 20# candy516

1. Sub ex()
   
2. Dim A As Range, B As Range, B1 As Range, B2 As Range, C As Range, Rng As Range, Rng1 As Range, d As Object
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Set sht = Sheets.Add(after:=Sheets(1))
   
5. Application.ScreenUpdating = False
   
6. With Sheet1
   
7.    For Each A In .Range(.[A2], .[A65536].End(xlUp))
   
8.       mystr = A & "," & A.Offset(, 1)
   
9.       d(mystr) = DateValue(Format(A.Offset(, 1), "0000/00/00"))
   
10.    Next
    
11. End With
    
12. k = 1: r = 1
    
13. For Each ky In d.keys
    
14. y = Left(Split(ky, ",")(1), 4)
    
15. With Sheets(y)
    
16. Set C = .Columns("A").Find(d(ky))
    
17. Set B = .Rows(1).Find(Split(ky, ",")(0))
    
18. If Not C Is Nothing And Not B Is Nothing Then
    
19. x = Application.Max(3, C.Row - 5)
    
20.    Set Rng = .Cells(x, 1).Resize(5, 1)
    
21.    Set Rng1 = .Cells(x, B.Column).Resize(5, 1)
    
22.    With sht
    
23.       Rng.Copy .Cells(r, k)
    
24.       Rng1.Copy .Cells(r, k + 1)
    
25.       .Cells(r, 3) = y & "¦~²Ä" & B.Column - 1 & "µ§"
    
26.    End With
    
27.    r = r + 5
    
28.    Else
    
29.    MsgBox "µL¦¹°£Åv¸ê®Æ"
    
30. End If
    
31. End With
    
32. Next
    
33. Application.ScreenUpdating = True
    
34. End Sub

½Æ»s¥N½X

candy516

¦^´_ 21# Hsieh


«e½ú±z¦n¡G
§Ú¬ã¨s¤F³o¦¸±oµ{¦¡½X©M¤§«eªºµ{¦¡½X¦³¦ó¤£¦P¡Aµo²{¤£¦P¤§³B¦b©ó
mystr = A & "," & A.Offset(, 1)d(mystr) = DateValue(Format(A.Offset(, 1), "0000/00/00"))
Next
End With
k = 1: r = 1
For Each ky In d.keys
y = Left(Split(ky, ",")(1), 4)
With Sheets(y)
½Ð°ÝLeft(A.Offset(, 1), 4)¦³¤°»ò®t§O©O?
¦A½Ð°Ý¦pªG§Ú¥u·Q­nÅã¥Ü¨Æ¥ó¤é«á²Ä¤­¤Ñªº³ø¹S§ÚÀ³¸Ó«ç»ò§ï©O?
(Á|¨Ò¨Ó»¡¡A¨Æ¥ó¤é¬O20041119¡A«h§Ú­n20041123ªº¸ê®Æ(t+4))
§Ú¸Õ¤F¦n¤[ÁÙ¬O¤£¦¨¥\­C!= =
«D±`·PÁÂ!^^

Hsieh

¦^´_ 22# candy516


    ¥i¯à¦³2ºØ±¡ªp§a

1. Sub ex()
   
2. Dim A As Range, B As Range, B1 As Range, B2 As Range, C As Range, Rng As Range, Rng1 As Range, d As Object
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Set sht = Sheets.Add(after:=Sheets(1))
   
5. Application.ScreenUpdating = False
   
6. With Sheet1
   
7.    For Each A In .Range(.[A2], .[A65536].End(xlUp))
   
8.       mystr = A & "," & A.Offset(, 1)
   
9.       d(mystr) = DateValue(Format(A.Offset(, 1), "0000/00/00"))
   
10.       '­Y¬Oª½±µ¥Î¨Æ¥ó«á²Ä4¤Ñ°µ·j´M­È
    
11.       'd(mystr) = DateValue(Format(A.Offset(, 1), "0000/00/00")) + 4
    
12.    Next
    
13. End With
    
14. k = 1: r = 1
    
15. For Each ky In d.keys
    
16. y = Left(Split(ky, ",")(1), 4)
    
17. With Sheets(y)
    
18. Set C = .Columns("A").Find(d(ky))
    
19. Set B = .Rows(1).Find(Split(ky, ",")(0))
    
20. If Not C Is Nothing And Not B Is Nothing Then
    
21. x = Application.Max(3, C.Row - 5)
    
22.    '¥Î¨Æ¥ó¤é¦V¤W4®æ¬°¥Ø¼Ð
    
23.    Set Rng = .Cells(x, 1)
    
24.    Set Rng1 = .Cells(x, B.Column)
    
25.    'ª½±µ¥Î¨Æ¥ó«á²Ä4¤Ñ°µ·j´M­È
    
26.    'Set Rng = .Cells(C.Row, 1)
    
27.    'Set Rng1 = .Cells(C.Row, B.Column)
    
28. 
    
29.    With sht
    
30.       Rng.Copy .Cells(r, k)
    
31.       Rng1.Copy .Cells(r, k + 1)
    
32.       .Cells(r, 3) = y & "¦~²Ä" & B.Column - 1 & "µ§"
    
33.    End With
    
34.    r = r + 1 '¥u¦³¤@¤Ñ¸ê®Æ©Ò¥H¥u­n¥[1
    
35.    Else
    
36.    MsgBox "µL" & y & "¦~" & Split(ky, ",")(0) & "¨Æ¥ó¸ê®Æ"
    
37. End If
    
38. End With
    
39. Next
    
40. Application.ScreenUpdating = True
    
41. End Sub

½Æ»s¥N½X

candy516

¦^´_ 23# Hsieh


ÁÂÁ«e½úªº¸Ñ»¡!
«e½ú©Ò¼gªºµ{¦¡½X¯uªºÀ°§Ú«Ü¤jªº¦£¡A
§Ú²{¦b¥i¥H¦Û¥Ñªº§ó§ï§Ú·Q­n§ì¨úªºÄæ¦ì!
©ÎªÌ¬O¯S©w­þ¤@¤Ñªº¸ê®Æ!
¯uªº«Ü·PÁ±z!^^
ÁÂÁÂ!

candy516

¦^´_ 23# Hsieh


   
«e½ú±z¦n~
§Ú²{¦b¤S¦^Âk¨ì¥»¥DÃD¤@¶}©lªºµ{¦¡½X¡A
§Ú²{¦b´«¿z¿ï¥X¨S¶ñÅvªÑ²¼ªº³ø¹S²v¡A§Ú±NÀɮפU¸ü¦¨¤@¼Ëªº®æ¦¡¡A
¦ý¶K¤Wµ{¦¡½X°õ¦æ«á¡A¥¦»¡«¬ºA¤£²Å!
½Ð°Ý¬O­þ¸Ì¥X¤F°ÝÃD!?
§Ú¬O¥Î¥H¤Uªºµ{¦¡½X!

1. Sub ex()
   
2. Dim A As Range, B As Range, B1 As Range, B2 As Range, C As Range, Rng As Range, Rng1 As Range, d As Object
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Set sht = Sheets.Add(after:=Sheets(1))
   
5. Application.ScreenUpdating = False
   
6. With Sheet1
   
7.    For Each A In .Range(.[A2], .[A65536].End(xlUp))
   
8.       mystr = A & "," & Left(A.Offset(, 1), 4)
   
9.       d(mystr) = DateValue(Format(A.Offset(, 1), "0000/00/00"))
   
10.    Next
    
11. End With
    
12. k = 1: r = 1
    
13. For Each ky In d.keys
    
14. y = Split(ky, ",")(1)
    
15. With Sheets(y)
    
16. Set C = .Columns("A").Find(d(ky))
    
17. Set B = .Rows(1).Find(Split(ky, ",")(0))
    
18. If Not C Is Nothing And Not B Is Nothing Then
    
19. x = Application.Max(3, C.Row - 14)
    
20.    Set Rng = .Cells(x, 1).Resize(15, 1)
    
21.    Set Rng1 = .Cells(x, B.Column).Resize(15, 1)
    
22.    With sht
    
23.       Rng.Copy .Cells(r, k)
    
24.       Rng1.Copy .Cells(r, k + 1)
    
25.       .Cells(r, 3) = y & "¦~²Ä" & B.Column - 1 & "µ§"
    
26.    End With
    
27.    r = r + 15
    
28.    Else
    
29.    MsgBox "µL¦¹°£Åv¸ê®Æ"
    
30. End If
    
31. End With
    
32. Next
    
33. Application.ScreenUpdating = True
    
34. End Sub

½Æ»s¥N½X

(¦]¬°¸ê®ÆÀɮפӤj¡A©Ò¥H§Ú¥ý§R°£¨ä¥L¤E¦~ªº¸ê®Æ¡A¥u³Ñ2010)

ÁÂÁ±z!^^

Hsieh

¦^´_ 25# candy516

1. Sub ex()
   
2. On Error Resume Next
   
3. Dim A As Range, B As Range, B1 As Range, B2 As Range, C As Range, Rng As Range, Rng1 As Range, d As Object
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. Set sht = Sheets.Add(after:=Sheets(1))
   
6. Application.ScreenUpdating = False
   
7. With Sheet1
   
8.    For Each A In .Range(.[A2], .[A65536].End(xlUp))
   
9.       mystr = A & "," & Left(A.Offset(, 1), 4)
   
10.      '§ASheet1ªºAÄæ¬O¥H¤é´Á®æ¦¡yyyy/m/d¿é¤J¡A¦ý®æ¦¡³]¦¨yyyymmdd¡A©Ò¥H¡A³y¦¨«D¥þ³¡¬°8½X
    
11.    '¥ÎTEXTÄݩʱo¨ì©Ò¨£¦r¦ê
    
12.       d(mystr) = DateValue(Format(A.Offset(, 1).Text, "0000/00/00"))
    
13.       If Err.Number <> 0 Then MsgBox A & A.Offset(, 1)
    
14.    Next
    
15. End With
    
16. k = 1: r = 1
    
17. For Each ky In d.keys
    
18. y = Split(ky, ",")(1)
    
19. With Sheets(y)
    
20. Set C = .Columns("A").Find(d(ky))
    
21. Set B = .Rows(1).Find(Split(ky, ",")(0))
    
22. If Not C Is Nothing And Not B Is Nothing Then
    
23. x = Application.Max(3, C.Row - 14)
    
24.    Set Rng = .Cells(x, 1).Resize(15, 1)
    
25.    Set Rng1 = .Cells(x, B.Column).Resize(15, 1)
    
26.    With sht
    
27.       Rng.Copy .Cells(r, k)
    
28.       Rng1.Copy .Cells(r, k + 1)
    
29.       .Cells(r, 3) = y & "¦~²Ä" & B.Column - 1 & "µ§"
    
30.    End With
    
31.    r = r + 15
    
32.    Else
    
33.    MsgBox "µL¦¹°£Åv¸ê®Æ"
    
34. End If
    
35. End With
    
36. Next
    
37. Application.ScreenUpdating = True
    
38. End Sub

½Æ»s¥N½X

candy516

¦^´_ 26# Hsieh


§Ú¤]¬O·Q»¡¬O¨ºÃ䪺°ÝÃD,§Ú¤]°µ¹L­×§ï!= =
¦ý¨S¦³¦¨¥\¡A ©Ò¥H¬O¥u­n§â®æ¦¡§ï±¼§Y¥i¡A¹ï§a!
ÁÂÁ±z­ò!^^

candy516

¦^´_ 26# Hsieh


«e½ú±z¦n¡G
    ¦bªþÀɸ̪ºSHEET1¤¤¡AA5ÃÒ¨é¥N½X¬°3009¡A§Ú¬O·Q­n§ì¥X20050103«á¤­¤Ñ(§t·í¤Ñ)¡A
©Ò¥H¥¿½TÀ³¸Ó§ì¨úªº¸ê®Æ¬°2005/1/7  -7.7104¡A¦ýµ{¦¡¶]¥X¨ÓÅܦ¨2005/11/9  7.402!
§Ú¬ã¨s¤@¤Uµo²{¡A¥u­n­ì©l¸ê®Æ¬O1¡B2¤ëªº³£¬O¤£¹ïªº­C!
¤S­n³Â·Ð±zÀ°§Ú¸Ñµª¤@¤U¡A¤£¦n·N«ä!
ÁÂÁ±z!^^

Hsieh

¦^´_ 28# candy516

¥¿³W¤Æªí®æ¬O®Ú¥»¸Ñ¨M¤§¹D
¤£¹L±o­n¥ýÀ¿§¹§¾ªÑ³á

¦Ü©óµ{¦¡°ÝÃDÂI¬O¥X¦b
Set C = .Columns("A").Find(d(ky), lookat:=xlWhole)
Set B = .Rows(1).Find(Split(ky, ",")(0), lookat:=xlPart)
¥[¤J·j´M°Ñ¼Æ´N¯à¥¿½T§ä¨ì¸ê®Æ¤F

candy516

«e½ú­Ì¦n~
¥¿³W¤Æ¬O«ü±N³o¨Ç¸ê®Æªí³æ§â¾ã²z¦¨¤@©wªº®æ¦¡¶Ü?¬OÅý¸ê®Æ§ó¦³¯´§Ç¶Ü?!
©Ò¥H»¡¥¿³W¤Æ¬O¤]»Ý­n¥Îµ{¦¡½X¨Ó°õ¦æÁÙ¬O»¡¹³¬O¼Ï¯Ã¤ÀªR¤§Ãþªº¶Ü?
¥t¥~¤@°Ý¡A¡§À¿§¾ªÑ¡¨¬O¤°»ò·N«ä?
ÁÂÁÂ~^^