- ©«¤l
- 129
- ¥DÃD
- 25
- ºëµØ
- 0
- ¿n¤À
- 159
- ÂI¦W
- 0
- §@·~¨t²Î
- win7
- ³nÅ骩¥»
- office2010
- ¾\ŪÅv
- 20
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2011-12-24
- ³Ì«áµn¿ý
- 2022-12-12
|
- Option Explicit '¥²¶·¸m©ó¼Ò²Õ³»ºÝ ±j¨î«Å§iÅܼÆ
- Private Sub CommandButton1_Click()
- Dim Sh As Worksheet, i As Integer, ii As Integer, r As Integer, Ar 'Dim «Å§iÅܼÆ
- Dim k As Integer
-
- Application.DisplayAlerts = False
- Application.ScreenUpdating = False
- For Each Sh In Sheets
- If Sh.Name <> "¤u§@ªí1" And Sh.Name <> "¤u§@ªí2" And Sh.Name <> "ªí®æ½d¥»" Then Sh.Delete
- '¬¡¶Ã¯¥u¯d ¤u§@ªí1¡G¬O¿é¤J°Ï,¤u§@ªí2¡G¬O¾ú¥v°O¿ý ,"ªí®æ½d¥»"
- Next
-
- With Sheets("¤u§@ªí2")
- If .UsedRange.Rows.Count = 1 Then '¨S¦³¾ú¥v¬ö¿ý
- '.UsedRange.Rows.Count = 1
- Sheets("¤u§@ªí1").UsedRange.Copy '½Æ»s(§t¼ÐÀY)
- .Range("A1").PasteSpecial xlPasteValues
-
- Else
- Sheets("¤u§@ªí1").UsedRange.Offset(1).Copy '½Æ»s(¤£§t¼ÐÀY)
- Sheets("¤u§@ªí2").Range("A" & .UsedRange.Rows.Count).Offset(3).PasteSpecial xlPasteValues
- 'Offset(3) :ªÅ2¦C->²Ä3¦C¶K¤W
-
- End If
-
-
- End With
-
-
- With Sheets("¤u§@ªí1")
-
- .UsedRange.Range("E:E").AdvancedFilter xlFilterCopy, , .Cells(1, .Columns.Count), True
- '¶i¶¥¿z¿ï EÄæ ¤£«½Æ¸ê®Æ¨ì¤u§@ªí³Ì¥kÄæ ***¨ú±oÃþ§Oªº¤ÀÃþ***
- 'AdvancedFilter:¶i¶¥¿z¿ï
- 'xlFilterCopy:¶i¶¥¿z¿ïªº¸ê®ÆÅã¥Ü¦b¨ä¥L¦a¤è
- '.Cells(1, .Columns.Count) ->¤u§@ªíªº³Ì¥kÄæ²Ä1ÓÀx¦s®æ->¶i¶¥¿z¿ïªº¸ê®ÆÅã¥Üªº¦a¤è
-
- i = 2
- Do While .Cells(i, .Columns.Count) <> "" '¤u§@ªí³Ì¥kÄ檺Àx¦s®æ <>""
- .Range("A:E").AutoFilter 5, .Cells(i, .Columns.Count) 'AutoFilter: ¦Û°Ê¿z¿ï ,²Ä5Äæ(Ãþ§O)ªº·Ç«h¬° .Cells(i, .Columns.Count)
- Sheets("ªí®æ½d¥»").Copy , Sheets(Sheets.Count)
- Set Sh = ActiveSheet
- Sh.[a1] = .Cells(i, .Columns.Count) & "¤ä¥Xªí"
- Sh.Name = .Cells(i, .Columns.Count)
- r = 5
- For Each Ar In .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Rows '¿z¿ï¥Xªº¸ê®Æ¦C
- If r = 17 Then
- r = 6
- Sh.Copy , Sheets(Sheets.Count)
- Set Sh = ActiveSheet
- Sh.Range("A6:E16") = ""
- End If
- Sh.Cells(r, "a").Resize(, Ar.Columns.Count) = Ar.Value 'Index(AR, ii) :Ū¨ú°}¦C
- r = r + 1
- Next
- i = i + 1
- Loop
-
- k = 1
- Do While .Cells(k, .Columns.Count) <> ""
- .Cells(k, .Columns.Count) = ""
- k = k + 1
- Loop
-
- '.Cells(1, .Columns.Count).CurrentRegion = ""
- .AutoFilterMode = False
- End With
- Application.ScreenUpdating = True
- Me.Activate
- End Sub
½Æ»s¥N½X ¦^´_ 14# iceandy6150
§Ú¸Õ¥X¨Ó¤F¡A¶K¤W¥N½X¤ÎªþÀÉ
·PÁÂG¤j¼ö¤ß±Ð¾Ç
¥un¦b¤u§@ªí1¡A¿é¤J¸ê®Æ¡A«ö¤U«ö¶s¡A´N¯à¦Û°Ê²£¥Í¬Û¹ïÀ³ªº¤u§@ªí
¨Ã±N¸ê®Æ¤ÀÃþ¦n©ñ¨ì¬Û¹ïÀ³ªº¤u§@ªí¤º¡A¥i¨Ñ¨Ï¥ÎªÌª½±µ¦C¦L¥X¨Ó
¦Ó¨C¦¸°Ê§@¤]·|°O¿ý¦b¤u§@ªí2¤¤¡A·í§@¾ú¥v¬ö¿ý |
-
-
ttt.rar
(19.09 KB)
§¹¦¨ÀÉ
|