GBKEE

¦^´_ 39# iceandy6150

1. Option Explicit
   
2. Private Sub CommandButton2_Click()
   
3.     Sheets("°Ñ·Óªí").UsedRange.Columns(1).CreateNames True
   
4.     With Sheets("Sheet1").Range("G2:G150").Validation
   
5.         .Add Type:=xlValidateList, Formula1:="=" & Sheets("°Ñ·Óªí").UsedRange.Cells(1)
   
6.     End With
   
7. End Sub
   
8. Private Sub CommandButton4_Click()
   
9.     Dim i As Integer, C As Range
   
10.     For Each C In Sheets("Sheet1").UsedRange.Columns(7).Cells
    
11.         If C = "" Then MsgBox ("¦³ªÅ®æ"): Exit Sub
    
12.     Next
    
13.     MsgBox ("µLªÅ®æ")
    
14. End Sub
    
15. Sub Ex()
    
16.     Dim i As Integer
    
17.     'UsedRange.RANGE("G:G") -> ¤w¨Ï¥Î½d³òªºGÄæ·|©µ¦ù¨ì¤u§@ªíªºªº©³³¡
    
18.     'UsedRange.Columns(7)   -> ¶È¤w¨Ï¥Î½d³ò²Ä1Äæ½d³òºâ°_ªº²Ä7Äæ½d³ò
    
19.     For i = 1 To 3
    
20.         With Sheets.Add(, Sheets(Sheets.Count))
    
21.             If i = 1 Then
    
22.                 .[F1,I5] = "AA"
    
23.             ElseIf i = 2 Then
    
24.                 .[D1,F5] = "AA"
    
25.             Else
    
26.                 .[D2,F5] = "AA"
    
27.             End If
    
28.             MsgBox .UsedRange.Address
    
29.             MsgBox .UsedRange.Columns(5).Address
    
30.             MsgBox .UsedRange.Range("E:E").Address        '.[D2,F5]->¤u§@ªí²Ä¤@¦C¨S¸ê®Æ¦³¿ù»~
    
31.         End With
    
32.     Next
    
33. End Sub

½Æ»s¥N½X

iceandy6150

¦^´_ 38# Hsieh

·PÁ«ܦh¤j¤j¼ö¤ß¦^´_¡A·P°Ê¨ì§Ö­ú¤F
¨Ó¤£¤Î®ø¤Æ¤§«e¡A¥ýµo°Ý¤@¤U

§Ú­ì¥»ªºµ{¦¡¸Ì­±¥[¤F¨¾§b¥\¯à¡ASheet1³Ì¥kÃä¿z¿ï¥X¨Óªº¡A¦pªG°Ñ·Óªí¨S¦³¸ÓÃþ§O¡A·|¥X¿ù
©ó¬O¥[¤F¤U¦Cµ{¦¡
            With Sheets("°Ñ·Óªí")
            M = Sheets("Sheet1").Cells(i, .Columns.Count).Value
            Set Rng = .Range("A2:A30").Find(What:=M)
            
            If Rng Is Nothing Then
                MsgBox ("§ä¤£¨ì<<" & M & ">>¬Û¹ïÀ³Ãþ§O¡A½Ð¼W­×°Ñ·Óªí")
                MsgBox ("½Ð°O±o¥hÁ`ªí§â¥»¦¸¸ê®Æ§R°£¡A¥H§K­«ÂÐ")
                Sheets("Sheet1").AutoFilterMode = False
                Application.ScreenUpdating = True
                Me.Activate
                Exit Sub
            End If

           Sh.[C2] = Rng.Offset(, 2)
            Sh.Name = Rng.Offset(, 1)
            End With

µM«áSheet1ªº[Ãþ§O]Ä欰¤F©È¿é¤J°Ñ·Óªí¨S¦³ªºªF¦è¡A©Ò¥H³]¤F¤U©Ô¦¡¿ï³æ
ÁÙ¦³¬°¤F²M°£°®²b¡AÅý²Ä¤G¦¸¡B²Ä¤T¦¸¨Ï¥Î®É¡A.usedrange.rows.count¤£·|¥X¿ù
(©ú©ú¤U­±¦C³£¨SªF¦è¤F¡AÁÙ¬O§ì«Ü¤U­±ªº¦C)
©Ò¥H¥Îµ{¦¡¥h°µ»´°£¡A³]¤F«ö¶s2¡A¦p¤U

Private Sub CommandButton2_Click()
     Worksheets("°Ñ·Óªí").Activate
     Worksheets("°Ñ·Óªí").Range("A1:A30").Select
     Worksheets("°Ñ·Óªí").Range("A30").Activate
     Selection.CreateNames Top:=True, Left:=False, Bottom:=False, Right:= _
     False
'¨ä¹êA1:A30À³¸Ó¬OA1¨ìAÄ榳¸ê®Æªº³Ì«á¨º¤@¦C¡A¦ý§Ú¤£·|³]
'¥u¦n¥ý¹w³]30­ÓÃþ§O¡A¥H¤W¬O¿ý»s¥¨¶°¦A½Æ»s¶K¤Wªº

     Worksheets("Sheet1").Activate
Sheets("Sheet1").Range("A2:G150").Delete (xlShiftUp)
'³o¨â¦æ¬O²MªÅ¸ê®Æ¡A¤@¼Ë¬O¹w³]¨ì150¡Aµ´¹ï°÷¥Î
'¦pªG­n~¦³¦h¤Ö¸ê®Æ´N§R°£¦h¤Ö¸ê®Æ¡A§Ú¤S¤£·|¤F

With Sheets("Sheet1")
    With .Range("G2:G150").Validation
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
         xlBetween, Formula1:="=Ãþ§O"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .IMEMode = xlIMEModeNoControl
        .ShowInput = True
        .ShowError = True
    End With
End With
End Sub
'³oÃä¬O³]©w¤U©Ô¦¡¿ï³æ¡A¤@¼Ë¿ý¥¨¶°¦A¶K¹L¨Ó¥Î

³Ì«á·Q³]¤@­Ó¨¾§b¡AÀˬdSheet1ªºGÄæ(Ãþ§O)¡A¬O§_¦³[ªÅ¥Õ]
¦pªG¨S¿é¤J¡A´N¤£¯à¿z¿ï¤ÀÃþ¡A¤]¨S¿ìªk¥h<°Ñ·Ó­¶>¹ï·Ó
¤j·§ª¾¹D­n³]©w½d³ò~~Sheet1.Range(G2¨ìGÄæ³Ì«á¤@¦C)
¦pªG¦¹½d³ò¦³ªÅ¥ÕÄæ¡Aĵ§i¡A¨ÃExit sub
¦ý§Ú¸Õ¤£¥X¨Ó¡A½Ð±Ð¦U¦ì¤j¤j¸Ñµª¤F   <«ö¶s4>

Private Sub CommandButton4_Click()
Dim i
'¤èªk¤@¡A¥¢±Ñ
For Each c In Sheets("Sheet1").UsedRange("G:G")
If c = "" Then i = 1
Else i = 0
End If
Next
'¤èªk¤G¡A¥¢±Ñ
'If IsEmpty(Sheets("Sheet1").UsedRange("G:G")) Then
'¤èªk¤T¡A¥¢±Ñ
'If Sheets("Sheet1").UsedRange("G:G").SpecialCells(xlCellTypeBlanks) Is Nothing Then
'¤èªk¥|¡A¥¢±Ñ
'i = Sheets("Sheet1").UsedRange("G:G").SpecialCells(xlCellTypeBlanks)
'MsgBox (i)

If i = 1 Then MsgBox ("¦³ªÅ®æ")
Else
MsgBox ("µLªÅ®æ")
End If
End Sub

¨ä¹ê¦n¹³À³¸Ó¥ýÀˬdSheet1.usedrange.rows.count
(¥ýª¾¹D¿é¤J´Xµ§¸ê®Æ¡A°²³]23µ§)
¦A¥h¼ÆGÄ榳´Xµ§¡A¤p©ó23µ§´Nª¾¹D¦³¬Y´Xµ§¨S¶ñÃþ§O
¦³®É­Ô1~18µ§³£¦³¿ïÃþ§O¡A19.20.21¨S¿ï¡A22.23¦³¿ï

¥H¤Wµo°Ý¡A·PÁÂ

Hsieh

¦^´_ 34# iceandy6150
´ê­Ó¼ö¾x

1. Sub CreateTable()
   
2. Dim i%, Ar(), Rng As Range, A As Range, sht As Object, ky As Variant, k&, s&
   
3. Set sht = CreateObject("Scripting.Dictionary")
   
4. Application.DisplayAlerts = False
   
5. With Sheets("Sheet1")
   
6. i = .Index + 1
   
7. Do Until Sheets.Count < i '§R°£Sheet1¤§«áªº¤u§@ªí
   
8.    Sheets(i).Delete
   
9.    i = .Index + 1
   
10. Loop
    
11. For Each A In .Range(.[G2], .[G2].End(xlDown)) '¤ÀÃþÀx¦s
    
12.   Set Rng = Sheets("°Ñ·Óªí").[A:A].Find(A, lookat:=xlWhole) '§ä¨ì°Ñ·Ó
    
13.   If IsEmpty(sht(Rng.Offset(, 1).Value)) Then '¤ÀÃþ²Ä¤@­Ó
    
14.   ReDim Preserve Ar(0)
    
15.      Ar(0) = Array(A.Offset(, -3).Value, "", "", "", A.Offset(, -1).Value, "", A.Offset(, -2).Value)
    
16.      sht(Rng.Offset(, 1).Value) = Ar
    
17.      Else '¤ÀÃþÄ~Äò§ä¨ì
    
18.      Ar = sht(Rng.Offset(, 1).Value)
    
19.      s = UBound(Ar)
    
20.      ReDim Preserve Ar(s + 1)
    
21.      Ar(s + 1) = Array(A.Offset(, -3).Value, "", "", "", A.Offset(, -1).Value, "", A.Offset(, -2).Value)
    
22.      sht(Rng.Offset(, 1).Value) = Ar
    
23.      Erase Ar
    
24.    End If
    
25. Next
    
26. For Each ky In sht.keys '¥Î¤ÀÃþ·í¦¨¯Á¤Þ­È
    
27. Ar = sht(ky)
    
28. s = UBound(Ar) + 1
    
29. With Sheets.Add(after:=Sheets(Sheets.Count)) '·s¼W¤u§@ªí
    
30. .Name = ky '¥H¤ÀÃþ¬°ªí¦WºÙ
    
31.   Set Rng = Sheets("ªí®æ½d¥»").[A1:K22] 'ªí®æ½d¥»½d³ò
    
32.   Rng.Copy .[A1]: k = 0: .Cells(k + 2, 3) = ky
    
33.   For i = 0 To UBound(Ar) '¼g¤J¸ê®Æ
    
34.      .Cells(i + 7 + Int(i / 13) * 13, 4).Resize(, 7) = Application.Index(Ar, i)
    
35.     If (i + 1) Mod 13 = 0 Then k = k + 26: Rng.Copy .[A1].Offset(k, 0): .Cells(k + 2, 3) = ky '13µ§¬°¤@­Óªí®æ
    
36.   Next
    
37. End With
    
38. Next
    
39. 'Âà¦ÜÁ`ªí
    
40. If MsgBox("¬O§_¦s¤JÁ`ªí", vbYesNo) = 6 Then .Range("A1").CurrentRegion.Offset(1).Copy Sheets("Á`ªí").Cells(.Rows.Count, 1).End(xlUp).Offset(3)
    
41. MsgBox "¤ÀÃþ§¹¦¨"
    
42. End With
    
43. End Sub

½Æ»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

c_c_lai

¦^´_ 34# iceandy6150
¤S¡B¥H¤U³B¸Ì²M°£°Ê§@¡G

1.         '  k = 1
   
2.         '  Do While .Cells(k, .Columns.Count) <> ""
   
3.         '      .Cells(k, .Columns.Count) = ""
   
4.         '      k = k + 1
   
5.         '  Loop

½Æ»s¥N½X

¥i°Ñ¦Ò GBKEE ¦b "¹ï¯S©wÄæ¶i¦æ¿z¿ï©M´À¥N¸ê®Æ" ¤@¤å¤¤´£¤ÎªºÂ²¼ä¡B§ã­n¤§¨Ï¥Î»yªk¡A
¦Ó´À´« Do While ~ Loop ´`Àô§PÂ_ª½¦Ü±ø¥ó¤£¦¨¥ß¬°¤îªº¥Îªk
(P.S.  ÁöµM¦¹³B¥u¦³¨âÄæ¸ê®Æ¡A¦ýÁ`¦@«o°õ¦æ¤F¤T½ë)¡C

1. .Cells(1, .Columns.Count).CurrentRegion = ""

½Æ»s¥N½X

c_c_lai

¦^´_ 34# iceandy6150
½Ð±N¥H¤U¤§¤C¶µ "X: X" ¤º¤§ªÅ¥Õ¥h°£¡F

1. 1.  .UsedRange.Range("G: G").AdvancedFilter xlFilterCopy, , .Cells(1, .Columns.Count), True
   
2. 2.  .Range("A: G").AutoFilter 7, .Cells(i, .Columns.Count)  '  AutoFilter:  ¦Û°Ê¿z¿ï ,²Ä7Äæ(Ãþ§O)ªº·Ç«h¬° .Cells(i, .Columns.Count)
   
3. 3.  Set Rng = .Range("A1: A18").Find(What:=M)
   
4. 4.  R = Application.CountA(Sh.[D7: D19])   '  ¦³¿é¤Jªº¸ê®Æ¼Æ
   
5. 5.  If Application.CountA(Sh.[D7: D19]) = 13 Then
   
6. 6.  Sh.[D7: J19] = ""
   
7. 7.  Sh.[D33: J45] = ""

½Æ»s¥N½X

§_«h·|²£¥Í¿ù»~°T®§¡C (¥¿½TÀ³¬° "X:X")

1. 1.  .UsedRange.Range("G:G").AdvancedFilter xlFilterCopy, , .Cells(1, .Columns.Count), True
   
2. 2.  .Range("A:G").AutoFilter 7, .Cells(i, .Columns.Count)  '  AutoFilter:  ¦Û°Ê¿z¿ï ,²Ä7Äæ(Ãþ§O)ªº·Ç«h¬° .Cells(i, .Columns.Count)
   
3. 3.  Set Rng = .Range("A1:A18").Find(What:=M)
   
4. 4.  R = Application.CountA(Sh.[D7:D19])   '  ¦³¿é¤Jªº¸ê®Æ¼Æ
   
5. 5.  If Application.CountA(Sh.[D7:D19]) = 13 Then
   
6. 6.  Sh.[D7:J19] = ""
   
7. 7.  Sh.[D33:J45] = ""

½Æ»s¥N½X

iceandy6150

¦^´_ 33# GBKEE

§Ú²×©ó§¹¦¨Åo¡Aªþ¤WÀÉ®×

¹s¥Îª÷²M³æ-¤W¶Ç¥Î.rar (47.84 KB)

¤U¸ü¦¸¼Æ: 16

2014-2-6 21:43

·PÁÂG¤j¤Î¨ä¥L¼ö¤ßª©¤ÍªºÀ°¦£

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

c_c_lai

¦^´_ 31# iceandy6150
§A¥i¥H½Ð±Ð  ¤p»xª©¤j¡C

iceandy6150

¦^´_ 34# c_c_lai

C¤j±z¦n¡A¤£ª¾¹D¬°¤°»ò¡A²Ä3­¶¥H«áªº¤å³¹¡A¥]¬A±zªº¤å³¹¡A³£µLªkÅã¥Ü¤F
§Ú¥u¯à±q[´£¿ô]¸Ì­±¥h«ö¦^Âбzªº¤å³¹

¬Q±ß§Ú¥ÎIE¶}¨â¤T­Óµøµ¡µL®Ä¡A¥ÎCHROME¶}¨â¤T­Ó¤]µL®Ä
¦Û¤v¦^ÂЪº©«¤]¬Ý¤£¨ì¡A¥u¯à¬Ý¨ì²Ä30«h¤å³¹¦Ó¤w

[attach]17434[/attach]