[µo°Ý] ¤À³Î¸ê®Æ¦¨¬°·s¼W¤u§@ªí

b9208

¦U¦ì¥ý¶i±z¦n
½Ð°Ý¦p¦ó¨Ì·Ó¤u§@ªí¤º¤§¯S©wÀx¦s®æ¸ê®Æ¡A
¤À³Î¸ê®Æ¦¨¬°·s¼W¤u§@ªí¨Ã¸m©ó­ì¤u§@ªí¤§«á¡A
§ó§ï·s¼W¤u§@ªí¦WºÙ¬°Àx¦s®æ¸ê®Æ¡A¦P¬¡­¶Ã¯¤º¡A¦pªþ¥ó»¡©ú¡C
¯¬¤j®a·s¦~§Ö¼Ö¡A¤ß·Q¨Æ¦¨¡A§»¨ß¤j®i¡C
B2.rar (4.35 KB)

¤U¸ü¦¸¼Æ: 16

2011-2-1 10:50

Hsieh

¦^´_ 1# b9208

1. Sub Split_Sheet()
   
2. Dim Rng As Range, A As Range
   
3. Application.DisplayAlerts = False
   
4. With Sheets("WW")
   
5. .Select
   
6. p = ActiveWindow.Zoom
   
7. For Each sht In Sheets
   
8. If sht.Name <> .Name Then sht.Delete
   
9. Next
   
10. For Each A In .Range(.[F1], .Cells(.Rows.Count, 6).End(xlUp))
    
11.    If IsDate(A) Then
    
12.       If Rng Is Nothing Then
    
13.          Set Rng = A
    
14.          Else
    
15.          Set Rng = Union(Rng, A)
    
16.       End If
    
17.     End If
    
18. Next
    
19. Set Rng = Union(Rng, .Cells(.Rows.Count, 1).End(xlUp).Offset(2, 5))
    
20. For i = 1 To Rng.Areas.Count - 1
    
21.    Set myrng = .Range(Rng.Areas(i).Offset(-1, -5), Rng.Areas(i + 1).Offset(-2, 9))
    
22.    sh = myrng.Cells(2, 7)
    
23.    With Sheets.Add
    
24.    .Name = sh
    
25.    myrng.Copy .[A1]
    
26.    For j = 1 To myrng.Rows.Count
    
27.       .Rows(j).RowHeight = myrng.Rows(j).RowHeight
    
28.    Next
    
29.    For k = 1 To myrng.Columns.Count
    
30.       .Columns(k).ColumnWidth = myrng.Columns(k).ColumnWidth
    
31.    Next
    
32.    ActiveWindow.Zoom = p
    
33.    End With
    
34. Next
    
35. End With
    
36. Application.DisplayAlerts = True
    
37. End Sub

½Æ»s¥N½X

b9208

·PÁ Hsieh ª©¥D
°õ¦æok
¤u§@ªí±Æ¦C¥i¥H¦p¤U¤è¦¡¡G
WW, Mon, Tue, ......., Sun
¥Ø«e±Æ¦C Sun, Sat, ........, WW

ÁÂÁÂ

Hsieh

«ü©w·s¼W¤u§@ªí¦ì¸m
With Sheets.Add(after:=Sheets(Sheets.Count))

b9208

Hsieh ª©¥D
±Æ¦Cok
¦ý¦³¥t¤@°ÝÃD¡A¨ä¥L¤u§@ªí³£§R°£¤F¡]°£¤FWW¤Î·s¼WMon, Tue,...¡^
¦P¤@Àɮפ¤§t¦³¨ä¥Lªº¤u§@ªí
" If sht.Name <> .Name Then sht.Delete "
ÁÂÁ±z

Hsieh

¦^´_ 5# b9208

1. Sub Split_Sheet()
   
2. Dim Rng As Range, A As Range
   
3. Application.DisplayAlerts = False
   
4. ar = Array("Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun")
   
5. With Sheets("WW")
   
6. .Select
   
7. p = ActiveWindow.Zoom
   
8. For Each sht In Sheets
   
9. If IsNumeric(Application.Match(sht.Name, ar, 0)) Then sht.Delete
   
10. Next
    
11. For Each A In .Range(.[F1], .Cells(.Rows.Count, 6).End(xlUp))
    
12.    If IsDate(A) Then
    
13.       If Rng Is Nothing Then
    
14.          Set Rng = A
    
15.          Else
    
16.          Set Rng = Union(Rng, A)
    
17.       End If
    
18.     End If
    
19. Next
    
20. Set Rng = Union(Rng, .Cells(.Rows.Count, 1).End(xlUp).Offset(2, 5))
    
21. For i = 1 To Rng.Areas.Count - 1
    
22.    Set myrng = .Range(Rng.Areas(i).Offset(-1, -5), Rng.Areas(i + 1).Offset(-2, 9))
    
23.    sh = myrng.Cells(2, 7)
    
24.    With Sheets.Add(after:=Sheets(Sheets.Count))
    
25.    .Name = sh
    
26.    myrng.Copy .[A1]
    
27.    For j = 1 To myrng.Rows.Count
    
28.       .Rows(j).RowHeight = myrng.Rows(j).RowHeight
    
29.    Next
    
30.    For k = 1 To myrng.Columns.Count
    
31.       .Columns(k).ColumnWidth = myrng.Columns(k).ColumnWidth
    
32.    Next
    
33.    ActiveWindow.Zoom = p
    
34.    End With
    
35. Next
    
36. End With
    
37. Application.DisplayAlerts = True
    
38. End Sub

½Æ»s¥N½X

b9208

Dear Hsieh

vbaµ{¦¡°õ¦æok

«D±`·PÁ±z

b9208

¦^´_ 6# Hsieh

ª©¥D±z¦n
¦p¼W¥[²M³æ¸ê®Æªí
¥ÑMon~Sun¤u§@ªí¤¤¡A¨Ì·ÓOÄæ¸ê®Æ¡A³]©w²Ä¤@­Ó¦r¬°E,M,R,T,U,Sµ¥¡A¦C¥X©Ò»ÝÄæ¦ì¸ê®Æ¡C
¦pªþ¥ó©Ò¥Ü¡AÁÂÁÂ

B2-1.rar (14.83 KB)

¤U¸ü¦¸¼Æ: 8

2011-2-1 22:49

Hsieh

¦^´_ 8# b9208

1. Sub Ex()
   
2. Dim Ay()
   
3. Dim Sh As Worksheet
   
4. For Each Sh In Sheets
   
5.    With Sh
   
6.    If IsNumeric(Application.Match(.Name, Array("Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun"), 0)) Then
   
7.       For Each A In .Range("O:O").SpecialCells(xlCellTypeConstants)
   
8.          If IsNumeric(Application.Match(Left(A, 1), Array("E", "M", "R", "S", "T", "U", "W"), 0)) Then
   
9.             ar = Array(Format(.[F2], "yyyy/mm/dd"), .Name, .Cells(A.Row, "E"), .Cells(A.Row, "G"), .Cells(A.Row, "H"), .Cells(A.Row, "I"), .Cells(A.Row, "J"), .Cells(A.Row, "K"), .Cells(A.Row, "M"), .Cells(A.Row, "N"), A)
   
10.             ReDim Preserve Ay(s)
    
11.             Ay(s) = ar
    
12.             s = s + 1
    
13.          End If
    
14.       Next
    
15.     End If
    
16.     End With
    
17. Next
    
18. With Sheets("Qt List")
    
19. If s > 0 Then .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(s, 11) = Application.Transpose(Application.Transpose(Ay))
    
20. End With
    
21. End Sub

½Æ»s¥N½X

b9208

¦^´_ 6# Hsieh

Hsieh ª©¥D
©ó¤À³Î«á¤§¤u§@ªí¡]Mon.........Sun)¡A¨Ì¾Ú[M5]¤§¶µ¥Ø±Æ§Ç¡]¥Ñ¤p¦Ü¤j¡A¨S¦³¼ÐÃD¦C¡^
¼W¥[¤§µ{¦¡½X¦p¤U¡G
With Sheets.Add(after:=Sheets(Sheets.Count))
    ............
     .[A6].Resize(j, 15).Sort Key1:=.[M5], Header:=xlNo
     ActiveWindow.Zoom = p
   End With

¦ý[M5]Äæ¦ì¤§¸ê®Æ³£¬O³Q®æ¦¡¤Æ¦¨¤å¦rªº¼Æ¦r¡A
¦b±Æ§Ç¿ï¶µ¤¤¡ª±N¥ô¦ó¬Ý¦ü¼Æ¦rªº¶µ¥Øµø¬°¼Æ¦r¨Ó±Æ¦C¡ª¦¹¿ï¶µ¥i¥H§¹¦¨¡C
½Ð±Ð­n¦p¦ó­×§ïµ{¦¡½X¡C

«D±`·PÁÂ