- ©«¤l
- 522
- ¥DÃD
- 36
- ºëµØ
- 1
- ¿n¤À
- 603
- ÂI¦W
- 0
- §@·~¨t²Î
- win xp sp3
- ³nÅ骩¥»
- Office 2003
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2012-12-13
- ³Ì«áµn¿ý
- 2021-7-11
|
¦^´_ 1# melvinhsu
¸Õ¸Õ¬Ý¡G
- '¥Ñ¿é¤J¨ì¿é¥X
- Private Sub CommandButton1_Click()
- Dim sh1, sh2, sh3 As Worksheet
- Dim r1, i, lastRow1, lastRow2, lastRow3, msg As Integer
- Dim «È¤á As String
- Set sh1 = Sheets("¿é¤J")
- Set sh2 = Sheets("¿é¥X")
- Set sh3 = Sheets("¾ú¥v")
-
- sh2.Cells.Clear '¥þ³¡²M°£ "¿é¥X"
- sh2.ResetAllPageBreaks '«³]©Ò¦³ªº¤À¶½u
-
- sh1.Rows("1:1").Copy sh2.Rows("1:1") '½Æ»s "¿é¤J"ªº¼ÐÃD¦C ¨ì "¿é¥X"
- lastRow1 = sh1.[A65536].End(xlUp).Row '¨ú±o "¿é¤J"ªºÄæA ³Ì¤U±«DªÅ¥Õ¦C ªº¦C¸¹
- lastRow3 = sh3.[A65536].End(xlUp).Row '¨ú±o "¾ú¥v" AÄæ³Ì¤U±«DªÅ¥Õ¦C ¦C¸¹
-
-
- '//////
- '«Ø¥ß"¿é¥X"ªº¤£«ÂЫȤá¦W³æ
- '¤£«Âпz¿ï, ±Nµ²ªG½Æ»s ÄæG(°²©w "¿é¤J"ÄæG ¥H«á¨S¸ê®Æ)
- Set rng = sh1.[A1].Resize(lastRow1, 1)
-
- rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rng, _
- CopyToRange:=sh1.Range("G1"), Unique:=True
-
- sh1.Columns("G:G").Copy sh2.Columns("A:A") '½Æ»s "¿é¤J"ªºÄæG(¿z¿ïµ²ªG) ¨ì "¿é¥X"ªºÄæA
- sh1.Columns("G:G").Delete '§R°£ "¿é¤J"ªºÄæG
-
- lastRow2 = sh2.[A65536].End(xlUp).Row '¨ú±o "¿é¥X" AÄæ³Ì¤U±«DªÅ¥Õ¦C ªº¦C¸¹
-
- '//////
- '¥Ñ¤U©¹¤WÂX®i¨CӫȤ᪺¤u§@¦C(¨CӫȤá20¦C), ¨Ã¥[¤J¤À¶½u
- For i = 2 To lastRow2
- sh2.HPageBreaks.Add Before:=sh2.Cells(i + 1, 1) '´¡¤J¤ô¥¤À¶½u
- Next
- For i = lastRow2 To 2 Step -1
- sh2.Cells(i + 1, 1).Resize(19, 1).EntireRow.Insert Shift:=xlDown
- Next
-
- '//////
- '±N"¿é¤J"ªº «È¤á¸ê®Æ½Æ»s¨ì"¿é¥X"
- For r1 = 2 To lastRow1
-
- '¦pªG¬OªÅ¥Õ®æ, ´«¤U¤@µ§
- If sh1.Cells(r1, 1) = "" Then Exit For
-
- '§_«h ±q "¿é¤J" ½Æ»s«È¤á¸ê®Æ ¨ì"¿é¥X"
- «È¤á = sh1.Cells(r1, 1)
- ½Æ»s«È¤á¸ê®Æ «È¤á, r1
- Next
-
- '//////
- '±N"¿é¤J"ªº «È¤á¸ê®Æ«O¦s¨ì"¾ú¥v"
- sh1.[A2].Resize(lastRow1, 3).Copy sh3.Cells(lastRow1 + 1, 1)
- msg = MsgBox("¤w±N¡i¿é¤J¡jªº«È¤á¸ê®Æ ½Æ»s¨ì¡i¾ú¥v¡j¤¤, " & Chr(10) _
- & "n²M°£¡i¿é¤J¡jªº«È¤á¸ê®Æ¶Ü?", vbYesNo)
- If msg = vbYes Then
- sh1.[A2].Resize(lastRow1, 3).Clear
- End If
- End Sub
- Sub ½Æ»s«È¤á¸ê®Æ(ByVal «È¤á As String, ByVal r1 As Integer)
- Dim sh1, sh2 As Worksheet
- Dim i, lastRow2 As Integer
- Dim cel, cel2, rng As Range
- Set sh1 = Sheets("¿é¤J")
- Set sh2 = Sheets("¿é¥X")
-
- lastRow2 = sh2.[A65536].End(xlUp).Row '¨ú±o "¿é¥X" AÄæ³Ì¤U¤@¦C¦C¸¹
- Set rng = sh2.[A1].Resize(lastRow2, 1) '³]©w"¿é¥X"·j´M(Find)½d³ò
-
- '¨ú±o "¿é¥X"²Ä¤@µ§«È¤á ªº cel
- Set cel = rng.Find(What:=«È¤á, After:=sh2.[A1], LookIn:=xlValues, _
- lookat:=xlWhole, MatchByte:=True)
-
- '±N "¿é¥X"«È¤áªº²Ä¤@µ§¦CÈ °£¥H20, ¦pªG¾l2,
- '¦Ó¥B³o¤@µ§ªº¥ª¤@®æ(Offset(0, 1))¬OªÅ¥Õ®æ¡÷©|¥¼¦³«È¤á¸ê®Æ(¥u¦³«È¤á¦WºÙ)
- '¡÷±q"¿é¤J" ½Æ»s«È¤á¸ê®Æ ¨ì"¿é¥X"
- If cel.Row Mod 20 = 2 And cel.Offset(0, 1) = "" Then
- sh1.Cells(r1, 1).Resize(1, 3).Copy cel
- Else
-
- '¨ú±o"¿é¥X"«È¤á ªº ³Ì«á¤@µ§¦CÈ+1
- i = cel.Row
- Do
- i = i + 1
- Loop Until sh2.Cells(i, 1) = "" Or sh2.Cells(i, 1) <> «È¤á
-
- 'Y ³Ì«á¤@µ§«È¤áªº¦CÈ+1 ¬OªÅ¥Õ
- '¡÷±q"¿é¤J" ½Æ»s«È¤á¸ê®Æ ¨ì"¿é¥X"(§t«È¤á¦WºÙ)
- If sh2.Cells(i, 1) = "" Then
- sh1.Cells(r1, 1).Resize(1, 3).Copy sh2.Cells(i, 1)
-
- '§_«h, "¿é¥X" ³Ì«á¤@µ§«È¤áªº¦CÈ+1 ¬O¥t¤@¦ì «È¤á¦W³æ,
- '¡÷³o¦ì«È¤áªº ªÅ¥Õ¦C ¤w¥Î§¹,
- 'ÂX®i³o¦ì«È¤áªºªÅ¥Õ¦C, ¨Ã¥[¤J¤À¶½u
- Else
- sh2.Cells(i, 1).Resize(20, 1).EntireRow.Insert Shift:=xlDown
- sh2.HPageBreaks.Add Before:=sh2.Cells(i, 1)
- End If
- End If
- End Sub
½Æ»s¥N½X |
|