VBA¨D±Ï°ª¤â¡A±N¸ê®Æ«ö¶¦¸¶¶§Ç±Æ¦C
- ©«¤l
- 51
- ¥DÃD
- 11
- ºëµØ
- 0
- ¿n¤À
- 110
- ÂI¦W
- 0
- §@·~¨t²Î
- win 10
- ³nÅ骩¥»
- office 2007
- ¾\ŪÅv
- 20
- µù¥U®É¶¡
- 2017-7-15
- ³Ì«áµn¿ý
- 2024-10-27
|
VBA¨D±Ï°ª¤â¡A±N¸ê®Æ«ö¶¦¸¶¶§Ç±Æ¦C
±N¸ê®ÆÂà¨ìA~FÄæ
¤@¶¬°120Ó¶µ¥Ø
²Ä¤@¶
A=1~40
C=41~80
E=81~120
²Ä¤G¶
A=121~160
C=161~200
E=201~240
....¨ì³Ì«á
|
-
-
test1.rar
(62.5 KB)
|
|
|
|
|
|
- ©«¤l
- 1447
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1471
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-12-5
|
¦^´_ 1# wsx1130
¥H¤U¬O«á¾Ç½m²ß¯dªÅ¥Õ¦b¤U¤èªº¤èªk,½Ð«e½ú°Ñ¦Ò
°õ¦æµ²ªG ³Ì«á¶:
Option Explicit
Sub TEST_A2()
Dim xA As Range, xR As Range, R%
Intersect(ActiveSheet.UsedRange, Range("a:f")).Offset(2, 0).Clear
ActiveSheet.ResetAllPageBreaks
Application.ScreenUpdating = False
R = 40: Set xA = [a3]: Set xR = [k2]
Head:
Do While xR <> ""
If xA.Column = 7 Then
Set xA = xA(R + 1, -5)
xA.PageBreak = xlPageBreakManual
If xR(R * 3) = "" Then
R = (Cells(Rows.Count, "K").End(3).Row - 1) Mod R * 3
R = IIf(R Mod 3, R \ 3 + 1, R \ 3)
GoTo Head
End If
End If
xR.Resize(R, 2).Copy xA
Set xR = xR(R + 1): Set xA = xA(1, 3)
Loop
ActiveSheet.PageSetup.PrintArea = Range([F1], Cells(Rows.Count, "A").End(3)).Address
End Sub |
|
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y
|
|
|
|
|
- ©«¤l
- 1447
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1471
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-12-5
|
¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-1-18 08:18 ½s¿è
¦^´_ 1# wsx1130
ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
ÁÂÁ 㴣³¡ªL«e½ú«ü¾É
¥H¤U¬O«á¾Ç¾Ç²ß¤ß±o,½Ð«e½ú°Ñ¦Ò,½Ð¦U¦ì«e½ú¦A«ü¾É
Option Explicit
Sub TEST_A1()
Dim xA As Range, xR As Range
'¡ô«Å§iÅܼÆ:(xA,xR)¬OÀx¦s®æÅܼÆ
Intersect(ActiveSheet.UsedRange, Range("a:f")).Offset(2, 0).Clear
'¡ô¥O¥æ¶°ªº½d³òÀx¦s®æ ©¹¤U°¾²¾2¦C½d³ò ²M°£
'¥æ¶°ªº½d³òÀx¦s®æ: ¾Þ§@ªí¤w¨Ï¥ÎªºÀx¦s®æ½d³ò »P[A:F]ÄæÀx¦s®æ«Å|ªºÀx¦s®æ
,https://learn.microsoft.com/zh-tw/office/vba/api/excel.application.intersect
Application.ScreenUpdating = False
'¡ô¥O¿Ã¹õµe±¼È¤£ÀHµ{§Ç°µÅܤÆ
Set xA = [a3]: Set xR = [k2]
'¡ô¥OxA³oÀx¦s®æÅܼƬO Àx¦s®æ[A3] :¥OxR³oÀx¦s®æÅܼƬO Àx¦s®æ[K2]
Do While xR <> ""
'¡ô³]±ø¥ó°j°é(·íxRÅܼÆȤ£¬OªÅ¦r¤¸!´NÄ~Äò°õ¦æ)
'https://learn.microsoft.com/zh-tw/dotnet/visual-basic/language-reference/statements/do-loop-statement
xR.Resize(40, 2).Copy xA
'¡ô¥OxRÅܼÆÂX®i¦V¤U40¦C,¦V¥kÂX®i2Ä檺½d³òÀx¦s®æ½Æ»s¨ì xAÅܼÆ
Set xR = xR(41): Set xA = xA(1, 3)
'¡ô¥OxRÅܼƴ«¦¨¬O ¦Û¨(§t)©¹¤U41¦C¦ì¸mÀx¦s®æ
'¥OxAÅܼƴ«¦¨¬O ¦Û¨(§t)©¹¥k3Äæ¦ì¸mÀx¦s®æ
'xR(41) = xR(41,1) = xR.Item(41, 1)
If xA.Column = 7 Then Set xA = xA(41, -5)
'¡ô¦pªGxAÅܼƪºÄ渹¬O7 (GÄæ)!
'´N¥OxAÅܼƴ«¦¨¬O ¦Û¨(§t)©¹¤U41¦C/©¹¥ª7Äæ¦ì¸mÀx¦s®æ
'¦Û¨(§t)¬O1,©¹¥ª7Äæ:(-5,-4,-3,-2,-1,0,1)
'(A,B,C,D,E,F,G)
Loop
End Sub |
|
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y
|
|
|
|
|
- ©«¤l
- 51
- ¥DÃD
- 11
- ºëµØ
- 0
- ¿n¤À
- 110
- ÂI¦W
- 0
- §@·~¨t²Î
- win 10
- ³nÅ骩¥»
- office 2007
- ¾\ŪÅv
- 20
- µù¥U®É¶¡
- 2017-7-15
- ³Ì«áµn¿ý
- 2024-10-27
|
¦^´_ 2# ã´£³¡ªL
·Ç¤j¯uªº¦n¼F®`¡A§Ú¥Îfor ¤@ª½¥dÃö¡A´`Àô¨ì¤@ª½·í¡A±zªºÅÞ¿è¯uªº«Ü¼F®`
´X¦æ´N¸Ñ¨M§Úªº°ÝÃD |
|
|
|
|
|
|
- ©«¤l
- 2836
- ¥DÃD
- 10
- ºëµØ
- 0
- ¿n¤À
- 2892
- ÂI¦W
- 0
- §@·~¨t²Î
- ¡e²¤¡f
- ³nÅ骩¥»
- ¡e²¤¡f
- ¾\ŪÅv
- 100
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¡e²¤¡f
- µù¥U®É¶¡
- 2013-5-13
- ³Ì«áµn¿ý
- 2024-12-4
|
Sub TEST_A1()
Dim xA As Range, xR As Range
Intersect(ActiveSheet.UsedRange, Range("a:f")).Offset(2, 0).Clear
Application.ScreenUpdating = False
Set xA = [a3]: Set xR = [k2]
Do While xR <> ""
xR.Resize(40, 2).Copy xA
Set xR = xR(41): Set xA = xA(1, 3)
If xA.Column = 7 Then Set xA = xA(41, -5)
Loop
End Sub |
|
|
|
|
|
|