GBKEE

¦^´_ 2# iceandy6150

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim i As Integer, Sh As Worksheet
   
4.     Application.DisplayAlerts = False
   
5.     For Each Sh In Sheets
   
6.         If Sh.Name <> "¤u§@ªí1" And Sh.Name <> "¤u§@ªí2" Then Sh.Delete
   
7.         '¬¡­¶Ã¯¥u¯d ¤u§@ªí1¡G¬O¿é¤J°Ï,¤u§@ªí2¡G¬O¾ú¥v°O¿ý
   
8.     Next
   
9.     With Sheets("¤u§@ªí2")
   
10.         If .UsedRange.Rows.Count = 1 Then               '¨S¦³¾ú¥v¬ö¿ý
    
11.             Sheets("¤u§@ªí1").UsedRange.Copy            '½Æ»s(§t¼ÐÀY)
    
12.             .Range("a1").PasteSpecial xlPasteValues
    
13.         Else
    
14.             Sheets("¤u§@ªí1").UsedRange.Offset(1).Copy  '½Æ»s(¤£§t¼ÐÀY)
    
15.             .Range("A" & .UsedRange.Rows.Count).Offset(3).PasteSpecial xlPasteValues
    
16.             'Offset(3) :ªÅ2¦C->²Ä3¦C¶K¤W
    
17.         End If
    
18.         .UsedRange.Range("E:E").AdvancedFilter xlFilterCopy, , .Cells(1, .Columns.Count), True
    
19.         '¶i¶¥¿z¿ï EÄæ ¤£­«½Æ¸ê®Æ¨ì¤u§@ªí³Ì¥kÄæ ***¨ú±oÃþ§Oªº¤ÀÃþ***
    
20.         i = 2
    
21.         .Cells(1, .Columns.Count - 1) = .UsedRange.Range("E1")    '¶i¶¥¿z¿ïªºÄæ¦ì¦WºÙ¬OEÄ檺¼ÐÀY
    
22.         Do While .Cells(i, .Columns.Count) <> ""                  '¤u§@ªí³Ì¥kÄ檺Àx¦s®æ <>""
    
23.             Set Sh = Sheets.Add(, Sheets(Sheets.Count))           '·s¼WªºÃþ§O¤u§@ªí
    
24.             Sh.Name = .Cells(i, .Columns.Count)
    
25.             .Cells(2, .Columns.Count - 1) = Sh.Name
    
26.            .UsedRange.AdvancedFilter xlFilterCopy, .Cells(1, .Columns.Count - 1).Resize(2), Sh.[a1], True
    
27.            '¤u§@ªí2 ¶i¶¥¿z¿ï ·Ç«h[¤ÀÃþ]="¤u§@ªí1"³Ì¥kÄ檺Àx¦s®æ, ½Æ»s¨ì·s¼WªºÃþ§O¤u§@ªí[A1]
    
28.            Do While Sh.UsedRange.Rows.Count > 11                  '¸ê®Æ¦C>11¦C
    
29.                 Sh.Copy , Sheets(Sh.Index)                        '1 ­ì¤u§@ªí½Æ»s
    
30.                 Sh.Rows("11:" & Sh.Rows.Count).Delete             '2 ­ì¤u§@ªí§R°£11¦C¥H¤Uªº¸ê®Æ(«O«ù10¦C)
    
31.                 Set Sh = ActiveSheet                              '3 ½Æ»sªº¤u§@ªí «ü©wµ¹ÅܼÆ
    
32.                 Sh.Rows("2:11").Delete                            '4 ½Æ»sªº¤u§@ªí§R°£2:11¦Cªº¸ê®Æ
    
33.            Loop
    
34.            i = i + 1
    
35.         Loop
    
36.         .Cells(1, .Columns.Count).CurrentRegion = ""
    
37.     End With
    
38. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 7# iceandy6150

¸Õ¸Õ¬Ý

GBKEE

¦^´_ 9# iceandy6150
½Ð¬Ý¬Ý Sheets("¤u§@ªí2")³Ì¥kÃ䪺IVÄæ

GBKEE

¦^´_ 11# iceandy6150
¶·¦h¤F¸Ñµ{¦¡½Xªº·N¸q
§Úªº¬OSheets("¤u§@ªí2") §A§ï¬° Sheets("¤u§@ªí1")

1. With Sheets("¤u§@ªí1")'
   
2.     .UsedRange.Range("E:E").AdvancedFilter xlFilterCopy, , .Cells(1, .Columns.Count), True
   
3.     'AdvancedFilter:¶i¶¥¿z¿ï
   
4.    'xlFilterCopy:¶i¶¥¿z¿ïªº¸ê®ÆÅã¥Ü¦b¨ä¥L¦a¤è
   
5.    '.Cells(1, .Columns.Count) ->¤u§@ªíªº³Ì¥kÄæ²Ä1­ÓÀx¦s®æ->¶i¶¥¿z¿ïªº¸ê®ÆÅã¥Üªº¦a¤è

½Æ»s¥N½X

GBKEE

¦^´_ 17# iceandy6150

1. With Sheets("¤u§@ªí1")  '¤u§@ªíª«¥ó¤~¦³UsedRangeª«¥ó   
   
2.          With .Range("DataRange")  ' ¨S¦³UsedRange
   
3.          'a = .UsedRange.Rows.Count '
   
4.           MsgBox Application.CountA(.Columns(1)) '«ü©w"DataRange"²Ä¤@Äæ->¨Ï¥Îªº¦C¼Æ
   
5.        ' Application.CountA : VBA¤¤¨Ï¥Î¤u§@ªí¨ç¼Æ CountA  
   
6.        MsgBox Application.CountA(.Cells)      '"DataRange"½d³ò¤º
   
7.          End With         
   
8.     End With

½Æ»s¥N½X

15#

1. 'k = 1
   
2.         'Do While .Cells(k, .Columns.Count) <> ""
   
3.         '.Cells(k, .Columns.Count) = ""
   
4.         'k = k + 1
   
5.         'Loop
   
6.         .Cells(k, .Columns.Count).EntireColumn = ""    'EntireColumn :¾ãÄæ
   
7.         '.Cells(1, .Columns.Count).CurrentRegion = ""  'CurrentRegion:³sÄòªº¸ê®Æ½d³ò

½Æ»s¥N½X

16# Àɮתº¨p±K¸ê®Æ¾B½ª,¤W¶Ç¬Ý¬Ý

GBKEE

¦^´_ 19# iceandy6150
ªþÀɤWÁ`ªíGÄæÃþ§O¨S¼Æ¦r, ¦ý¤u§@ªí[«OÀI231],[³q°T203]..¦³¼Æ¦r ³o¨Ç¤u§@ªíªº©R¦W³W«h§A¨S»¡©ú!
[Á`ªí]¸ê®Æ¥i¦bHÄæ¥[µù¿ë§O·s¸ê®Æ
16# ¥i¯àÁÙ­n¥Î¤@­Ó¤u§@ªí¡A¸Ì­±©ñ°Ñ¦Ò­È¡A¤ñ¦p»¡ Ãþ§O¬°[¤@¯ë¨Æ°È¶O]¡A¨ºsh.name´N¬O[¤@¯ë¨Æ°È¶O279]¡A¦r¸¹¬°[±f¦r²Ä016¸¹]
±f¦r²Ä016¸¹ ¦b¦ó³B??
½Ð§iª¾ºÃ´b,µ{¦¡¤~¼gªº¤U¥h.

GBKEE

¦^´_ 21# iceandy6150
¨S¦³³W«ß©Ê¨º§A´N¥Î¤â°Ê

1. Option Explicit   '¥²¶·¸m©ó¼Ò²Õ³»ºÝ ±j¨î«Å§iÅܼÆ
   
2. Sub Ex()
   
3.     Dim i As Integer, Sh As Worksheet, Rng As Range, xRow As Range, R As Integer
   
4.     With Sheets("Á`ªí")
   
5.         If .UsedRange.Rows.Count = 1 Then              '¨S¦³¾ú¥v¬ö¿ý
   
6.            Sheets("Sheet1").UsedRange.Copy            '½Æ»s(§t¼ÐÀY)
   
7.             .Range("A1").PasteSpecial xlPasteValues
   
8.         Else
   
9.             Sheets("Sheet1").UsedRange.Offset(1).Copy  '½Æ»s(¤£§t¼ÐÀY)
   
10.             .Range("A" & .UsedRange.Rows.Count).Offset(3).PasteSpecial xlPasteValues
    
11.             'Offset(3) :ªÅ2¦C->²Ä3¦C¶K¤W
    
12.         End If
    
13.     End With
    
14.     With Sheets("SHEET1")  '¤u§@ªí:¿é¤J°Ï
    
15.         .Range("A1").CurrentRegion.Range("G:G").AdvancedFilter xlFilterCopy, , .Cells(1, .Columns.Count), True
    
16.         i = 2
    
17.         Do While .Cells(i, .Columns.Count) <> ""
    
18.             .Range("A1").AutoFilter 7, .Cells(i, .Columns.Count)         '¦Û°Ê¿z¿ï
    
19.             Set Sh = Sheets(Ãþ§Oªí(.Cells(i, .Columns.Count)))           '«ü©w¨ìÃþ§Oªº¤u§@ªí
    
20.             For Each xRow In .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Rows '¦Û°Ê¿z¿ï½d³ò¦Cªº¶°¦X
    
21.                 If xRow.Row > 1 Then
    
22.                      R = Application.CountA(Sh.[D7:D19])                 '¦³¿é¤Jªº¸ê®Æ¼Æ
    
23.                      With Sh.[D7].Offset(R)
    
24.                         .Cells(, 1) = xRow.Range("D1")
    
25.                         .Cells(, 5) = xRow.Range("F1")
    
26.                         .Cells(, 7) = xRow.Range("E1")
    
27.                      End With
    
28.                      If Application.CountA(Sh.[D7:D19]) = 13 Then
    
29.                          Sh.Copy , Sh
    
30.                          Set Sh = ActiveSheet
    
31.                         Sh.[D7:J19] = ""
    
32.                     End If
    
33.                 End If
    
34.             Next
    
35.         i = i + 1
    
36.         Loop
    
37.         .AutoFilterMode = False       '¦Û°Ê¿z¿ï¼Ò¦¡:¨ú®ø
    
38.         .UsedRange.Offset(1).Clear    '¸ê®Æ¿é¤J«á²M°£±¼
    
39.        ' .Cells(1, .Columns.Count).EntireColumn = ""
    
40.     End With
    
41. End Sub
    
42. Function Ãþ§Oªí(Ãþ§O As String)    '¦Û­q¨ç¼Æ: ´M§äÃþ§Oªº¤u§@ªí
    
43.     Dim ªí As String, Sh As Worksheet
    
44.     For Each Sh In Sheets                  'Sheets: ¤u§@ªíªº¶°¦X
    
45.         If InStr(Sh.Name, Ãþ§O) = 1 And Application.CountA(Sh.[D7:D19]) = 13 Then  'Ãþ§Oªº¤u§@ªí[D7:D19]¦³¿é¤Jªº¸ê®Æ¼Æ
    
46.             ªí = Sh.Name
    
47.         ElseIf InStr(Sh.Name, Ãþ§O) = 1 And Application.CountA(Sh.[D7:D19]) < 13 Then
    
48.             Ãþ§Oªí = Sh.Name
    
49.             Exit For
    
50.         End If
    
51.     Next
    
52.     If Ãþ§Oªí = "" And ªí <> "" Then
    
53.         Sheets(ªí).Copy , Sheets(ªí)
    
54.         Ãþ§Oªí = ActiveSheet.Name
    
55.     ElseIf Ãþ§Oªí = "" And ªí = "" Then
    
56.         '*** §ä¤£¨ìÃþ§Oªº¤u§@ªí ½Æ»s "ªí®æ" ªº½d¥»
    
57.         Sheets("ªí®æ").Copy Sheets(1)
    
58.         ActiveSheet.Name = Ãþ§O
    
59.         Ãþ§Oªí = Ãþ§O
    
60.     End If
    
61. End Function

½Æ»s¥N½X

¦^´_ 23# yen956
¨S¦³Ãö«Yªº,½×¾Â»Ý­n¼ö¤ßªº·|­û°Ñ»P.

GBKEE

¦^´_ 25# iceandy6150
¦h¿ý»s¥¨¶°:¥iª¾¦p¦ó¨Ï¥ÎVBAªº¤èªk.¨ç¼Æ.Äݩʮɾ÷,­n¥\¤Oªº¼W¶i,¤£¤G¤èªk¤U­W¤u(¦h¬Ý,¦h°Ý,¦h½m²ß).¤j¦h¼Æ®ÑÄyªº¤º®e,VBA»¡©ú³£¥i§ä¨ì.

1. Option Explicit
   
2. Private Sub CommandButton4_Click()
   
3.     Dim i As Integer, j, k As String, Rng As Range
   
4.     With Sheets("Sheet1")
   
5.         .UsedRange.Range("G:G").AdvancedFilter xlFilterCopy, , .Cells(1, .Columns.Count), True
   
6.     End With
   
7.     i = 2
   
8.     With Sheets("°Ñ·Óªí")
   
9.         Set Rng = .Range("A:A").Find(what:=Sheets("Sheet1").Cells(i, .Columns.Count))
   
10.         k = Rng.Offset(, 1)
    
11.         MsgBox (Rng)
    
12.         MsgBox (k)
    
13.     End With
    
14. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 28# iceandy6150
¿ý»s¥¨¶°¯à¦³¸Ñµª¡H? ÁÙ­n¦h¬ÝVBA»¡©ú.½m²ß,¤F¸Ñ¥¦ªº½d¨Ò(®Ñ¥»¤Wªº¨ç¼Æ,¤èªk,ÄÝ©Ê,VBA»¡©ú³£¦³)

¤U¸ü (47.15 KB)

2014-2-6 07:56

1. With Sheets("°Ñ·Óªí")
   
2.             Set Rng = .Range("A:A").Find(what:=Sheets("Sheet1").Cells(i, .Columns.Count))
   
3.             MsgBox Rng Is Nothing '¬O True ¨S¦³§ä¨ì ¤U­±´N¿ù»~
   
4.             '¨S¦³ª«¥ó«ü©w¨ì Rng
   
5.             j = Rng.Offset(, 1)
   
6.             End With
   
7.             Sh.[C2] = j      'Rng Is Nothing ¤]·|¦³¿ù»~
   
8.             Sh.Name = Rng    'Rng Is Nothing ¤]·|¦³¿ù»~
   
9.             
   
10.             j = ""              '¨S¥Îªº:³o¨â¦æ¬O§Úı±o¨Ï¥Î«á²MªÅ¡A¥[³o¨â¦æ¿ù»~¤]¨S®ø¥¢
    
11.             Rng = ""
    
12.             For Each xRow In .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Rows '¦Û°Ê¿z¿ï½d³ò¦Cªº¶°¦X
    
13.                 If xRow.Row > 1 Then
    
14.                      R = Application.CountA(Sh.[D7:D19])                 '¦³¿é¤Jªº¸ê®Æ¼Æ
    
15.                      With Sh
    
16.                         .[E3] = xRow.Range("B1")                        '@@@  ¦A§â¤é´Á¥[¶iE3
    
17.                         .[D7].Offset(R).Cells(, 1) = xRow.Range("D1")
    
18.                         .[D7].Offset(R).Cells(, 5) = xRow.Range("F1")
    
19.                         .[D7].Offset(R).Cells(, 7) = xRow.Range("E1")
    
20.                      End With

½Æ»s¥N½X

GBKEE

¦^´_ 34# iceandy6150
¸U¤V°ª¼Ó,±q¦a°_,§A¤w¦b¥´¦a°ò¤F
¨Ì§Aªº [¹s¥Îª÷²M³æ-¤W¶Ç¥Î.rar] ­×§ï¤@¤U

1. Option Explicit   '¥²¶·¸m©ó¼Ò²Õ³»ºÝ ±j¨î«Å§iÅܼÆ
   
2. Private Sub CommandButton1_Click()
   
3.     Dim Sh As Worksheet, i As Integer, R As Integer, Rng As Range, xRow As Range
   
4.     Application.ScreenUpdating = False
   
5.     With Sheets("Á`ªí")
   
6.         If .UsedRange.Rows.Count = 1 Then              '¨S¦³¾ú¥v¬ö¿ý
   
7.            Sheets("Sheet1").UsedRange.Copy             '½Æ»s(§t¼ÐÀY)
   
8.             .Range("A1").PasteSpecial xlPasteValues
   
9.         Else
   
10.             Sheets("Sheet1").UsedRange.Offset(1).Copy  '½Æ»s(¤£§t¼ÐÀY)
    
11.             .Range("A" & .UsedRange.Rows.Count).Offset(3).PasteSpecial xlPasteValues
    
12.                                                        'Offset(3) :ªÅ2¦C->²Ä3¦C¶K¤W
    
13.         End If
    
14.     End With
    
15.     With Sheets("Sheet1")
    
16.         .UsedRange.Range("G:G").AdvancedFilter xlFilterCopy, , .Cells(1, .Columns.Count), True
    
17.         i = 2
    
18.         Do While .Cells(i, .Columns.Count) <> ""                          '¤u§@ªí³Ì¥kÄ檺Àx¦s®æ <>""
    
19.             .Range("A:G").AutoFilter 7, .Cells(i, .Columns.Count)          'AutoFilter: ¦Û°Ê¿z¿ï ,²Ä7Äæ(Ãþ§O)ªº·Ç«h¬° .Cells(i, .Columns.Count)
    
20.             Set Rng = Sheets("°Ñ·Óªí").Range("A1:A18").Find(.Cells(i, .Columns.Count)).Offset(, 1)
    
21.             Set Sh = Sheets(Ãþ§Oªí(Rng))
    
22.             Sh.Activate
    
23.             For Each xRow In .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Rows '¦Û°Ê¿z¿ï½d³ò¦Cªº¶°¦X
    
24.                 If xRow.Row > 1 Then
    
25.                     R = Application.CountA(Sh.[D7:D19])                 '¦³¿é¤Jªº¸ê®Æ¼Æ
    
26.                     With Sh
    
27.                         .[E3,E29] = xRow.Range("B1")                    '¤é´Á¥[¶iE3,E29
    
28.                         
    
29.                         .[D7].Offset(R).Cells(, 1) = xRow.Range("D1")
    
30.                         .[D7].Offset(R).Cells(, 5) = xRow.Range("F1")
    
31.                         .[D7].Offset(R).Cells(, 7) = xRow.Range("E1")
    
32.                         
    
33.                         .[D33].Offset(R).Cells(, 1) = xRow.Range("D1")
    
34.                         .[D33].Offset(R).Cells(, 5) = xRow.Range("F1")
    
35.                         .[D33].Offset(R).Cells(, 7) = xRow.Range("E1")
    
36.                     End With
    
37.                     If Application.CountA(Sh.[D7:D19]) = 13 Then
    
38.                         Sh.Copy , Sh
    
39.                         Set Sh = ActiveSheet
    
40.                         Sh.[D7:J19,D33:J45] = ""
    
41.                         'Sh.[D33:J45] = ""
    
42.                     End If
    
43.                 End If
    
44.             Next
    
45.             i = i + 1
    
46.         Loop
    
47.         .AutoFilterMode = False   '**** ¨ú®ø¦Û°Ê¿z¿ï¼Ò¦¡,¸ê®Æ¥þ³¡Åã¥Ü¤U­±ªº²M°£¤~¦³®ÄªG*****
    
48.    '     .UsedRange.Offset(1) = "'"                      'UsedRange: ¤u§@ªíªº¤w¨Ï¥Î½d³ò
    
49.         '.Cells(1, .Columns.Count).EntireColumn = ""    'EntireColumn:¾ãÄæ
    
50.         '.Cells(1, .Columns.Count).CurrentRegion = ""   'CurrentRegion: ¦³¸ê®Æªº©µ¦ù½d³ò
    
51.      '   .Activate
    
52.     End With
    
53.     Application.ScreenUpdating = True
    
54. End Sub
    
55. Function Ãþ§Oªí(Ãþ§O As Range) As String      '¦Û­q¨ç¼Æ: ´M§äÃþ§Oªº¤u§@ªí
    
56.     Dim ªí As String, Sh As Worksheet
    
57.     For Each Sh In Sheets                  'Sheets: ¤u§@ªíªº¶°¦X
    
58.         If InStr(Sh.Name, Ãþ§O) = 1 And Application.CountA(Sh.[D7:D19]) = 13 Then  'Ãþ§Oªº¤u§@ªí[D7:D19]¦³¿é¤Jªº¸ê®Æ¼Æ
    
59.             ªí = Sh.Name
    
60.         ElseIf InStr(Sh.Name, Ãþ§O) = 1 And Application.CountA(Sh.[D7:D19]) < 13 Then
    
61.             Ãþ§Oªí = Sh.Name
    
62.             Exit For
    
63.         End If
    
64.     Next
    
65.     If Ãþ§Oªí = "" And ªí <> "" Then
    
66.         Sheets(ªí).Copy , Sheets(ªí)
    
67.         ActiveSheet.[C2] = Ãþ§O.Offset(, 2)
    
68.         Ãþ§Oªí = ActiveSheet.Name
    
69.     ElseIf Ãþ§Oªí = "" And ªí = "" Then
    
70.         '*** §ä¤£¨ìÃþ§Oªº¤u§@ªí ½Æ»s "ªí®æ" ªº½d¥»
    
71.         Sheets("ªí®æ½d¥»").Copy Sheets(1)
    
72.         ActiveSheet.Name = Ãþ§O
    
73.         ActiveSheet.[C2] = Ãþ§O.Offset(, 1)
    
74.         Ãþ§Oªí = Ãþ§O
    
75.     End If
    
76. End Function

½Æ»s¥N½X