ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý]Àx¦s®æ³]©w½d³ò¤À³Î¦¨¤£¦P¤u§@ªí

[µo°Ý]Àx¦s®æ³]©w½d³ò¤À³Î¦¨¤£¦P¤u§@ªí

½Ð±ÐªO¤W¥ý¶i¡A³Ìªñ¦b·|­p¤W³B²z¤@¥÷¸ê®Æ
°Ñ¾\ªþ¥ó¡@ Àx¦s®æ³]©w½d³ò¤À³Î¦¨¤£¦P¤u§@ªí.zip (13.07 KB)

1.§Æ±æ¥i¥H±N¶À¦â©¼¦¹¤¤¶¡ªº½d³ò¤À¶}¦¨¤£¦Pªº¤u§@ªí
¡@¸û¦³Å޿誺¬O¨C±i³øªíµ²§ô®É¡A³£¦³­Ó¡¨³øªíµ²§ô¡¨

2.¦P®É§Æ±æ©R¦Wªº¤è¦¡¬O¥HÂŦ⪺³¡¤À
¡@¦ý¥Ø«e¥u¯à§ì¨ì¤ñ¸û©T©wªºÃö«Y¬OÂŦ⪺³¡¤À¸ò¤W¤@±i³øªíµ²§ôªº¬Û¹ï¦ì¸m¬O©T©wªº

·Q½Ð°Ý³o¥i¥H«ç»ò¼g©O¡H
Áٳ·ЦU¦ì¤j¤j¤F¡A·PÁ¡I

¦^´_ 1# kilon
  1. Sub SplitSheet()
  2. Dim A As Range, B As Range, r%, Sh As Worksheet
  3. Set A = [A1] 'A1¬°°_ÂI
  4. Do Until A.Address = first 'ª½¨ì¦A«×§ä¨ìªº¦ì¸m¬OA1
  5. first = "$A$1"
  6. Set B = Columns("G").Find("³ø ªí µ² §ô", after:=A.Offset(, 6)) 'GÄ椤§ä¨ì³øªíµ²§ô
  7. r = B.Row - A.Row
  8. ad = A.Resize(r + 1, 13).Address
  9. Set Sh = Worksheets.Add(after:=Sheets(Sheets.Count))
  10. Sh.Name = Replace(A.Offset(3, 3).Text, "/", "")
  11. A.Resize(r + 1, 13).Copy Sh.[A1]
  12. Set A = Columns("A").Find(A, after:=A) '§ä¤U¤@­Ó°_ÂI
  13. Loop
  14. End Sub
½Æ»s¥N½X

TOP

¦^´_ 2# white945
white945: §Aªºµ{¦¡­nµù©ú ¥²¶·½Æ»s¦b³o¤u§@ªíªº¼Ò²Õ¤¤ ,¦p½Æ»s¨ì¨ä¥L¼Ò²Õ ¥u¯à½Æ»s¤u§@ªí "¨ä¥LÀç·~¥~¦¬¯q" «á·|Â÷¶}°j°é.
  1. ¦p½Æ»s¨ì¨ä¥L¼Ò²Õ
  2. Set Sh = Worksheets.Add(after:=Sheets(Sheets.Count))  '¦¹¬°§@¥Î¤¤ªº¤u§@ªí
  3. Sh.Name = Replace(A.Offset(3, 3).Text, "/", "")
  4. A.Resize(r + 1, 13).Copy Sh.[A1]
  5. Set A = Columns("A").Find(A, after:=A)   
  6. '·|¬O¦b§@¥Î¤u§@ªí ¤¤´M§ä A.Address = first
½Æ»s¥N½X
­×§ï«á¥i¦b¥ô¦ó¼Ò²Õ°õ¦æ
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Sh As Worksheet, A As Range, G As Range, A_Address
  4.     Set Sh = Sheet1
  5.     Set A = Sh.Columns(1).Find("¬ì¥Ø½s¸¹½d³ò", LookAT:=xlWhole, after:=Cells(Rows.Count, 1))
  6.     '³Ì«á¤@¦C§ä°_
  7.     'Find: ¹w³]·|±q²Ä1¦C¤§«á¶}¨Ï§ä°_ '¤£«ü©w:²Ä¤@­Ó§ä¨ì·|¬O[A40]
  8.     A_Address = A.Address
  9.     Do
  10.         Set G = Sh.Columns(7).Find("***  ³ø ªí µ² §ô  ***", LookAT:=xlWhole, after:=Cells(A.Row, 7))
  11.         Sheets.Add(, Sheets(Sheets.Count)).Name = Replace(A.Cells(4, 4), "/", "-") ' '©Ò±oµ|¶O¥Î/§Q¯q "/" ¤£²Å¦X©R¦W³W«h
  12.         Range(A, G).EntireRow.Copy ActiveSheet.Range("a1")
  13.         Set A = Sh.Columns(1).Find("¬ì¥Ø½s¸¹½d³ò", LookAT:=xlWhole, after:=A)
  14.     Loop Until A.Address = A_Address
  15. End Sub
½Æ»s¥N½X

TOP

¦^´_ 3# GBKEE

¦hÁª©¥D´£¿ô
  1. Sub SplitSheet()
  2. Dim A As Range, B As Range, r%, Sh As Worksheet
  3. With Sheet1
  4. Set A = .[A1] 'A1¬°°_ÂI
  5. Do Until A.Address = first 'ª½¨ì¦A«×§ä¨ìªº¦ì¸m¬OA1
  6. first = "$A$1"
  7. Set B = .Columns("G").Find("³ø ªí µ² §ô", after:=A.Offset(, 6)) 'GÄ椤§ä¨ì³øªíµ²§ô
  8. r = B.Row - A.Row
  9. Set Sh = Worksheets.Add(after:=Sheets(Sheets.Count))
  10. Sh.Name = Replace(A.Offset(3, 3).Text, "/", "")
  11. A.Resize(r + 1, 13).Copy Sh.[A1]
  12. Set A = .Columns("A").Find(A, after:=A) '§ä¤U¤@­Ó°_ÂI
  13. Loop
  14. End With
  15. End Sub
½Æ»s¥N½X

TOP

·PÁ¤j¤j §Ú¸Õ¸Õ¬Ý!!!

¦^´_ 4# white945

TOP

white ¤j¤j
¥Î§Aªºµ{¦¡½X¡A·|¦b"r = B.Row - A.Row" µo¥Í¿ù»~¡A¿ù»~ªº­ì¦]¬O¨S¦³³]©wª«¥óÅܼƩΠWith °Ï¶ôÅܼÆ
¬O¦]¬°¦bDim¨ºÃä¨S¦³°w¹ïr³]©wÅܼƶÜ?

b]¦^´_ 4# white945

TOP

ª©¥D¤j¤j¡A§Aªº¦¨¥\¡I
¤£¹L§Ú¹J¨ì¤@­Ó°ÝÃD¡A¦]¬°¥Ø«eµ¹ªº¸ê®Æ¤W³£¥u¦³¤@­¶ªº³øªí¡A¦ý¦³¨Ç¨ä¹ê¤j©ó¤G­¶¡Aex:Àç·~¥~¦¬¤J

ªþ¥ó¦p¤U¡G
ªþ¥ó.zip (18.15 KB)
¦Ç¦â¬O·s¼Wªº³¡¤À¡A¦ÓÂŦâ¯S§O¼Ð¥Ü¬O¦]¬°¸ò³øªíµ²§ôªº¤G­¶¤¤¶¡®t¶Z¤ñ°_¨Ó¬O¤£¦Pªº

½Ð°Ý³o¼Ë¤l­n¦p¦ó­×§ï©O¡H
¥Ø«e¦Û¤v´ú¸Õ¨ì¥Ø«eªºµ²ªG¦n¹³¬O¦b¤§«e§ì½d³òªº®É­Ô¡A·|­«½Æ§ì¨ì½d³ò¡A¾É­P©R¦W·|­«½Æ
¤£¹L¨ä¹ê¦Û¤v¤]¤£½T©w¡D¡D¡D³o­ÓVBA¨ä¹ê¼gªº§ÚÁÙ¨S¦³¿ìªk°Ñ³z§r...
³Â·Ð¤j¤j­Ì¤F!

¦^´_ 3# GBKEE

TOP

¦^´_ 7# kilon
  1. Sub nn()
  2. Dim A As Range, B As Range, r%, Sh As Worksheet
  3. With Sheet1
  4. Set A = .[A1] 'A1¬°°_ÂI
  5. Do Until A.Address = first 'ª½¨ì¦A«×§ä¨ìªº¦ì¸m¬OA1
  6. Set B = .Columns("G").Find("***  ³ø ªí µ² §ô  ***", after:=A.Offset(, 6)) 'GÄ椤§ä¨ì³øªíµ²§ô
  7. r = B.Row - A.Row
  8. Set Sh = Worksheets.Add(after:=Sheets(Sheets.Count))
  9. Sh.Name = Replace(A.Offset(3, 3).Text, "/", "")
  10. A.Resize(r + 1, 13).Copy Sh.[A1]
  11. Do Until A.Row > B.Row Or A.Address = first 'ÁקK¤@­Ó³øªíµ²§ô¤º¦³1­Ó¥H¤W¬ì¥Ø
  12.   Set A = .Columns("A").Find(A, after:=A) '§ä¤U¤@­Ó°_ÂI
  13. Loop
  14. first = "$A$1"
  15. Loop
  16. End With
  17. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 8# Hsieh

ÁÂÁÂ!!¦¨¥\¤F!!
¥i¥H³Â·Ð¤j¤j¬Ý¬Ý§Ú¹ï³o­Óµ{¦¡½XªºªºÅÞ¿è²z¸Ñ¬O§_¥¿½T

Sub SplitSheet()¡@
Dim A As Range, B As Range, r%, Sh As Worksheet¡@¤£À´³o¸Ì³]©wr%¬O¤°»ò·N«ä
With Sheet1
Set A = .[A1] 'A1¬°°_ÂI
Do Until A.Address = first 'ª½¨ì¦A«×§ä¨ìªº¦ì¸m¬OA1
first = "$A$1"
Set B = .Columns("G").Find("³ø ªí µ² §ô", after:=A.Offset(, 6)) 'GÄ椤§ä¨ì³øªíµ²§ô
r = B.Row - A.Row

³oÃä§Ú¦³ÂI¤£¤Ó²z¸Ñ
¥uª¾¹D§ä¨ì³øªíµ²§ô¡A¦ýafter:=A.Offset(, 6) ³o­Ó¼gªk§Ú¤£¾å±o¤°»ò·N«ä¡A³o¼Ë§ì¨ìªº½d³ò¬O¤°»ò¡H
¥t¥~r = B.Row - A.Row §Ú·QÀ³¸Ó¤W¤@­Ó°ÝÃD¸Ñ¨M§¹³o­Ó³¡¤ÀÀ³¸Ó´N¥i¥H²z¸Ñ:)


Set Sh = Worksheets.Add(after:=Sheets(Sheets.Count))¡@
Sh.Name = Replace(A.Offset(3, 3).Text, "/", "")
A.Resize(r + 1, 13).Copy Sh.[A1]

½Ð°Ý³oÃ䪺Resize¬O¤°»ò¥\¯à¡H

Set A = .Columns("A").Find(A, after:=A) '§ä¤U¤@­Ó°_ÂI

³o­ÓÀ³¸Ó¸ò²Ä¤@­Ó°ÝÃDafter:=A.Offset(, 6)¦³Ãö«Y§a...

Loop
End With
End Sub

·PÁ¤j¤j

TOP

¥»©«³Ì«á¥Ñ Hsieh ©ó 2012-9-3 18:23 ½s¿è

¦^´_ 9# kilon

Set B = .Columns("G").Find("³ø ªí µ² §ô", after:=A.Offset(, 6))
³o¬O¦]¬°­n¦bGÄ椤§ä¨ì¦r¦ê¡A¦Ó´M§äªº¦ì¸m¥²¶·¬O§ä¨ì©Ò­nªº¬ì¥Ø¦ì¸m(Aªº¦ì¸m)¥H«á
¬G¦¹³]©w´M§äªºafter°Ñ¼Æ¡A±qA¦C©Ò¦bÀx¦s®æ¥H¤UªºGÄæ¶}©l´M§ä
Resize¦¡ÂX®i°Ï°ìªº·N«ä
±qAªº¦ì¸mÂX®i¦¨r+1¦C¡A13Ä檺½d³ò¡A§@¬°­n½Æ»sªº½d³ò
A¬O¦bAÄæ¡A¹³¤SÂX®i13Äæ¤~·|Åܦ¨A:MÄæ
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

        ÀR«ä¦Û¦b : ªY½à§O¤H´N¬O²øÄY¦Û¤v¡C
ªð¦^¦Cªí ¤W¤@¥DÃD