[µo°Ý] ¦p¦ó°µ¦¨¦Û°Ê¤À­¶(­¶½X)®ÄªG?

luke

¦U¦ì¤j¤j

1.[Sheet1ªí]ªº¡uA:OÄæ¡v¬°¸ê®Æ°Ï, ¨ä¤¤¡§A1:O8¡¨Àx¦s®æ·í§@¡i¦C¦L¼ÐÃD¦C¡j½d³ò,
    ¦Û²Ä9¦C¥H«á·|¦³¼Æ¶q¤£©wªº¸ê®Æ°Ï¶ô(¥]§t¤@¨Ç¦X¨ÖÀx¦s®æ),
    ¬ù¦³100¦h­Ó¸ê®Æ¦C·í§@¡i³]©w¦C¦L½d³ò¡j.

2.¦p¦ó±N¡§A1:O8¡¨Àx¦s®æ©w¸q¦¨©T©w¼ÐÃD¦C, ¥Ñ²Ä9¦C¶}©l­pºâ,
    ¨C14¦C¬°1­Ó¸ê®Æ°Ï¶ô°µ¦¨¦Û°Ê¤À­¶(­¶½X)®ÄªG¦pªþÀÉ»¡©ú.

·Ð½Ð¥ý¶i ¤j¤j«ü¾É
TEST31.rar (26.99 KB)

¤U¸ü¦¸¼Æ: 6

2013-6-12 18:52

stillfish00

¦^´_ 1# luke
°ÝÃD¤£¬O«ÜÀ´¡A¦pªG¬O«ü´¡¤J¼ÐÃD¦C¡A²£¥Í¦p"µ²ªG"ªº¤u§@ªí :

1. Sub TEST()
   
2.     Dim iPageCount As Integer
   
3.    
   
4.     Application.ScreenUpdating = False
   
5.     With Sheets("sheet1")
   
6.         iPageCount = (.[A7].CurrentRegion.Rows.Count - 2) / 14
   
7.         For i = 1 To iPageCount * 22 Step 22
   
8.             If i = 1 Then
   
9.                 .Cells(5, "M").Value = 1
   
10.                 .Cells(5, "O").Value = iPageCount
    
11.             Else
    
12.                 .Range("A1:O8").Copy
    
13.                 .Cells(i, 1).Insert Shift:=xlDown
    
14.                 .Cells(i + 4, "M").Value = Int(i / 22) + 1
    
15.             End If
    
16.         Next
    
17.         Application.CutCopyMode = False
    
18.     End With
    
19.     Application.ScreenUpdating = True
    
20. End Sub

½Æ»s¥N½X

luke

¦^´_ 2# stillfish00

¶i¦æ´ú¸Õ«á²Å¦X

·PÁÂstillfish00 ¦h¦¸¨ó§U

¥H¤W

GBKEE

¦^´_ 1# luke

1. Option Explicit
   
2. Sub TEST()
   
3.     Dim iPageCount As Integer, i As Integer
   
4.     Application.ScreenUpdating = False
   
5.     With Sheets("Sheet1")
   
6.         .Activate
   
7.         .PageSetup.PrintTitleRows = "$1:$5"                           '¼ÐÃD¦C
   
8.         iPageCount = (.[A7].CurrentRegion.Rows.Count - 2) / 14
   
9.         .Cells(5, "O").Value = iPageCount
   
10.         For i = 1 To iPageCount
    
11.             .Cells(5, "M").Value = i
    
12.             .Range(.Cells(9 + ((i - 1) * 14), "a"), .Cells(22 + ((i - 1) * 14), "O")).Name = "Print_Area"  '¦L¦C½d³ò
    
13.             .PrintOut                                                 '¦L¦C
    
14.         Next
    
15.         .Names("Print_Area").Delete
    
16.         .Names("Print_Titles").Delete
    
17.     End With
    
18.     Application.ScreenUpdating = True
    
19. End Sub

½Æ»s¥N½X

luke

¦^´_ 4# GBKEE

ÁÂÁ¶Wª©¦^ÂÐ

­Y[Sheet1ªí]¸ê®Æ°Ï(«üA:OÄæ)ªºªí®æ¤¤,
¦³¤@¨Ç¾ã¦C¬OµL¥ô¦ó¸ê®Æªºªí®æ¦C(§YªÅ¥Õ¸ê®Æ¦C)
¥B¸ÓªÅ¥Õªí®æ¦Cªº¦ì¸m¤£©T©w.

¦p¦ó¥ý¦æ§R°£³o¨ÇªÅ¥Õªí®æ¦C,
¦p¥»¨Ò²Ä19¦C¡B²Ä33¦C¡B²Ä44¦C¡B²Ä47¦C©M²Ä55-60¦C
ª½¨ìµLªÅ¥Õªí®æ¦C¬°¤î.

À³¦p¦ó­×§ïVBA?
TEST31-1.rar (27.64 KB)

¤U¸ü¦¸¼Æ: 5

2013-6-15 23:09

lilytracy

¦^´_ 5# luke

²M°£ªÅªí®æ¦C°Ñ¦Ò¦p¤U

1. Sub RowClear()
   
2. Dim row, i, j As Long
   
3. row = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).row
   
4. Application.ScreenUpdating = False
   
5. Range(Cells(9, 1), Cells(row, 1)).Select
   
6. For i = 9 To row
   
7. If Cells(i, 1).Value = "" And Cells(i, 3).Value = "" And Cells(i, 8).Value = "" Then
   
8.     Rows(i).Select
   
9.     Selection.Delete Shift:=xlUp
   
10.      i = i - 1
    
11.      j = j + 1
    
12.     If j = row Then
    
13.         Exit For
    
14.     End If
    
15. End If
    
16. Next
    
17. Application.ScreenUpdating = True
    
18. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 5# luke

1. Sub TEST()
   
2.     Dim iPageCount As Integer, i As Integer
   
3.     Application.ScreenUpdating = False
   
4.     With Sheets("Sheet1")
   
5.         For i = .UsedRange.Rows.Count To 9 Step -1
   
6.             If Application.Phonetic(.Rows(i)) = "" Then .Rows(i).Delete
   
7.         Next
   
8.         .Activate
   
9.         .PageSetup.PrintTitleRows = "$1:$5"                           '¼ÐÃD¦C
   
10.         iPageCount = (.[A7].CurrentRegion.Rows.Count - 2) / 14
    
11.         .Cells(5, "O").Value = iPageCount
    
12.         For i = 1 To iPageCount
    
13.             .Cells(5, "M").Value = i
    
14.             .Range(.Cells(9 + ((i - 1) * 14), "a"), .Cells(22 + ((i - 1) * 14), "O")).Name = "Print_Area"  '¦L¦C½d³ò
    
15.             .PrintPreview            '.PrintOut                                                        '¦L¦C
    
16.         Next
    
17.         .Names("Print_Area").Delete
    
18.         .Names("Print_Titles").Delete
    
19.     End With
    
20.     Application.ScreenUpdating = True
    
21. End Sub

½Æ»s¥N½X