VBA°µ¿z¿ï

sillykin

¦]¸ê®Æ¦³¤W¤dµ§¡K
¥i§_¯à¥ÎVBA°µ¿z¿ï..¦³°Ñ¦Ò¥»ºô¯¸¤§¿z¿ï½d¨Ò..ÁÙ¬O°µ¤£¤Ó¥X¨Ó..
°ÝÃD¤@¡B
¿z¿ïCÄæ¡BDÄæ¡BEÄæ¦ì°µ¬°·Ç«h
±Æ¦C¶¶§Ç¡A¥B¦b¢ÕÄæ¯à§_¼Ð¥Ü¤@¤U¡y­«ÂнЬd®Ö¡z
°ÝÃD¤G¡B
¥i§_¥[µùÃC¦â°µ¬°¤ñ¹ï¨Ì¾Ú
°ÝÃD¤T¡B
SHEET1¬°¸ê®Æ°Ï
¿z¿ï¥X¨Ó¥i§_¦bCOPY¨ìSHEET2

½Ð¤j¤j¨ó§U¤@¤U¡K·P®¦

sillykin

ÁÂÁÂg¤jª©¥Dªº±Ð¾É...¤p§Ì¥Ñ°J·PÁÂ

GBKEE

¦^´_ 18# sillykin

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Rng(1 To 3) As Range, i As Integer, E As Range
   
4.     'With Sheets("Sheet1")          ' "Sheet1" ¤u§@ªí¦WºÙ
   
5.    
   
6.     With Sheet1                     ' Sheet1  ¤u§@ªíª«¥ó¦WºÙ
   
7.         .Cells.Interior.ColorIndex = xlNone
   
8.         Set Rng(1) = .Range("A:F").SpecialCells(xlCellTypeConstants)                                    '¸ê®Æ®w
   
9.         .Range("G:G") = ""
   
10.         Set Rng(3) = Rng(1).Rows(1)
    
11.         For i = 1 To 7                                                                                  'CÄæ¡BDÄæ¡BEÄæ¦ì°µ¬°·Ç«h
    
12.            MsgBox .OLEObjects("CheckBox" & i).Object
    
13.             If .OLEObjects("CheckBox" & i).Object.Value = True Then     '¦³¤Ä¿ï=.Value = True       *****
    
14.                 .Cells(1, .Columns.Count) = Rng(1).Cells(1, i)                                          'Äæ¦ì°µ¬°·Ç«h
    
15.                 Rng(1).Columns(i).AdvancedFilter xlFilterCopy, , .Cells(1, .Columns.Count), True        '¿z¿ï¤£­«½Æªº¸ê®Æ
    
16.                 Set Rng(2) = .Range(.Cells(2, .Columns.Count), .Cells(2, .Columns.Count).End(xlDown))   '¿z¿ï¥Xªº¸ê®Æ½d³ò
    
17.                 For Each E In Rng(2)
    
18.                     If Application.CountIf(Rng(1).Columns(i), E) > 1 Then                               ' ¸ê®Æ¦b¸ê®Æ®w¸Ìªº¸ê®Æ¼Æ¤j©ó1
    
19.                         With Rng(1).Columns(i).Cells
    
20.                             .Replace E, "=XXX", xlWhole                                                 '§ó§ï¬°¿ù»~­È
    
21.                             With .SpecialCells(xlCellTypeFormulas, xlErrors)                            '¿ù»~­Èªº¯S®í½d³ò¸Ì
    
22.                                 .Value = E                                                              '¸m¦^­ì¨Óªº¸ê®Æ
    
23.                                 Set Rng(3) = Union(Rng(3), .Cells)                                      '¥[¤J½d³ò
    
24.                                 .Interior.Color = vbYellow
    
25.                                 .Offset(, Rng(1).Columns.Count + 1 - i) = "­«ÂнЬd®Ö"
    
26.                             End With
    
27.                         End With
    
28.                     End If
    
29.                 Next
    
30.             End If
    
31.         Next
    
32.         .Cells(1, .Columns.Count).EntireColumn = ""
    
33.         Set Rng(3) = Application.Intersect(.Cells, Rng(3).EntireRow)  '¾ã¦X¬°¾ã¦C
    
34.     End With
    
35.     With Sheets("Sheet2")
    
36.         .Cells.Clear
    
37.         Rng(3).Copy .Range("A1")
    
38.         .Cells.Interior.ColorIndex = xlNone
    
39.         .Cells.EntireColumn.AutoFit
    
40.     End With
    
41. End Sub

½Æ»s¥N½X

¤U¸ü (27.07 KB)

2013-9-8 06:40

¤U¸ü (42.49 KB)

2013-9-8 06:40

sillykin

¦^´_ 21# GBKEE


    G¤jª©¥D..¤S¤@­Ó¤p°ÝÃD½Ð±Ð...
¦pªG§ï¬°CheckBox¤Ä¿ï°µ¬°·Ç«h©O..³o­n¦p¦ó¥h³B²z©O????

GBKEE

¦^´_ 20# sillykin
¥i¨Ì¼Ëµe¸¬Äª¸Õ¸Õ¬Ý,¦³°ÝÃD¥i¦A´£°Ý(¦h½m²ßVBA·|¶i¨Bªº)

sillykin

¦^´_  sillykin
¸Õ¸Õ¬Ý
GBKEE µoªí©ó 1/9/2013 15:05

    g¤jª©¥D§A¦n..¤p§Ì¤£¤~..¤]ÁÂÁª©¥D­@¤ßªº±Ð¾É
©Ó«eÃD¦^ÂÐ6ªº¤½¦¡

01.Option Explicit

02.Sub Ex()

03.    Dim Rng(1 To 3) As Range, i As Integer, E As Range

04.    With Sheets("Sheet1")          ' "Sheet1" ¤u§@ªí¦WºÙ

05.        .Cells.Interior.ColorIndex = xlNone

06.        Set Rng(1) = .Range("A:F").SpecialCells(xlCellTypeConstants)                              '¸ê®Æ®w

07.        .Range("G:G") = ""

08.        Set Rng(3) = Rng(1).Rows(1)

09.        For i = 3 To 5                                      'CÄæ¡BDÄæ¡BEÄæ¦ì°µ¬°·Ç«h

10.            .Cells(1, .Columns.Count) = Rng(1).Cells(1, i)  'Äæ¦ì°µ¬°·Ç«h

11.            Rng(1).Columns(i).AdvancedFilter xlFilterCopy, , .Cells(1, .Columns.Count), True       '¿z¿ï¤£­«½Æªº¸ê®Æ

12.            Set Rng(2) = .Range(.Cells(2, .Columns.Count), .Cells(2, .Columns.Count).End(xlDown))  '¿z¿ï¥Xªº¸ê®Æ½d³ò

  For i = 3 To 5                                      'CÄæ¡BDÄæ¡BEÄæ¦ì°µ¬°·Ç«h
¦pªG§ó§ï¬°CÄæ¡BEÄæ¦ì°µ¬°·Ç«h ;DÄ椣°µ·Ç«h
¨º°µªk¬O¤£¬O¸ò§A¤W¤@ÃDªº¤è¦¡¤@¼Ë©O????

GBKEE

¦^´_ 18# sillykin

1. Option Explicit
   
2. Option Base 1  '<- ¤U­­­È¬° 1  ; ­Y­n³]¤U­­­È¬° 0¡A«h Option Base ³¯­z¦¡¬O¤£»Ý­nªº¡C
   
3. 
   
4. Dim Ar(), Ax()                            '³o¼Ò²Õ¤¤ªºµ{¦¡¥i¥Î¤§ÅܼÆ
   
5. Private Sub UserForm_Initialize()
   
6.     Dim D(1 To 6) As Object, i As Integer, R As Variant
   
7.     '********¦pªGSHEET1Äæ¦ì­È¬°A~DÄæ¦ì¤ÎFÄæ¦ì¤ÎGÄæ¦ì..***
   
8.     Ar = Array(1, 2, 3, 4, 6, 7)   '³]©wÄæ¦ì
   
9.     '****************************************************
   
10.     Ax = Array(ComboBox1, ComboBox2, ComboBox3, ComboBox4, ComboBox5, ComboBox6)    'ComboBox¤»­Ó¿ï¶µ¤º®e¨Ì§Ç¬° ²Õ§O,©m¦W1....
    
11.     With Sheet1
    
12.         .AutoFilterMode = False   'Åã¥Ü¥þ³¡¸ê®Æ ->·sªº ¦h­«¿z¿ï ¤~·|½T.
    
13.         For i = 1 To 6
    
14.             Set D(i) = CreateObject("Scripting.Dictionary")
    
15.             For Each R In .Range("A2", .[A2].End(xlDown))
    
16.                  '************ ­Y¹w³]ªº¤U­­­È¬° 0  ->   i - 1   *******************************************************
    
17.                  'D(i)(R.Offset(, Ar(i - 1) - 1).Value) = ""    'i = 1 ®É ­Y¹w³]ªº¤U­­­È¬°0 «h»ÝAr(i - 1)-> Ar(0) = 1'*
    
18.                  '*****************************************************************************************************
    
19.                  D(i)(R.Offset(, Ar(i) - 1).Value) = ""
    
20.             Next
    
21.             Ax(i).List = Application.Transpose(D(i).keys)
    
22.         Next
    
23.     End With
    
24. End Sub
    
25. Private Sub CommandButton1_Click() '¿z¿ï±ø¥ó
    
26.     Dim Rng As Range, i As Integer
    
27.     Application.ScreenUpdating = False
    
28.     Set Rng = ActiveSheet.Range("$A$1:$Q$300")
    
29.     Rng.Parent.AutoFilterMode = False       'Åã¥Ü¥þ³¡¸ê®Æ ->·sªº ¦h­«¿z¿ï ¤~·|½T.
    
30.     For i = 1 To 6                          '¦h­«¿z¿ï  ..........
    
31.         '************ ­Y¹w³]ªº¤U­­­È¬° 0  ->   i - 1   *****************************************************
    
32.         'If Ax(i - 1).Value <> "" Then Rng.AutoFilter Field:=Ar(i - 1), Criteria1:=Ax(i - 1).Value & "*"  '*
    
33.         '***************************************************************************************************
    
34.         If Ax(i).Value <> "" Then Rng.AutoFilter Field:=Ar(i), Criteria1:=IIf(i <> 5, Ax(i).Value & "*", Ax(i).Value)
    
35.                                                                '¤¸(Føó)¬°¼Æ­È¤£¥i¥Î * ¨Ó¿z¿ï
    
36.     Next
    
37.     Application.ScreenUpdating = True
    
38. End Sub
    
39. Private Sub CommandButton4_Click()
    
40.     With ActiveSheet.Range("$A$1:$Q$300") '½d³ò
    
41.         .Parent.AutoFilterMode = False   'Åã¥Ü¥þ³¡¸ê®Æ ->¨ú®ø ¦h­«¿z¿ï
    
42.     End With
    
43. End Sub

½Æ»s¥N½X

sillykin

G¤jª©¥D§A¦n..¤£¦n·N«ä¦b§n§A¤@¤U..
For i = 1 To 6

22.        With Controls("ComboBox" & i)

23.            If .Value <> "" Then

24.                Rng.AutoFilter Field:=i, Criteria1:=.Value & "*" '

25.            End If

26.        End With
¬O±±¨îComboBox" & i (1~6ªº±±¨î¿ï¶µ)
¦pªGSHEET1Äæ¦ì­È¬°A~DÄæ¦ì¤ÎFÄæ¦ì¤ÎGÄæ¦ì..­n¦p¦ó¤UVBAµ{¦¡©O??
¦]FOR 1 TO 6 ¬°³sÄòComboBox¿ïA~FÄæ¦ì
½ÐG¤jª©¥DÂI¤@¤U..¤p§Ì¤£¤~..ÁÂÁÂ

GBKEE

¦^´_ 15# sillykin

1. Option Explicit
   
2. Private Sub UserForm_Initialize()
   
3.     Dim D(1 To 6) As Object, i As Integer, R As Variant
   
4.     For i = 1 To 6
   
5.         Set D(i) = CreateObject("Scripting.Dictionary")
   
6.         With Sheet1
   
7.             For Each R In .Range("A2", .[A2].End(xlDown)) '
   
8.                  D(i)(R.Offset(, i - 1).Value) = ""
   
9.             Next
   
10.         End With
    
11.         Controls("ComboBox" & i).List = Application.Transpose(D(i).keys)
    
12.         'ComboBox¤»­Ó¿ï¶µ¶·­«·s,¨Ì§Ç©R¦W ComboBox1(²Õ§O) ...-> ComboBox6(¤¸)
    
13.     Next
    
14. End Sub
    
15. Private Sub CommandButton1_Click() '¿z¿ï±ø¥ó
    
16.     Dim Rng As Range, i As Integer
    
17.     Application.ScreenUpdating = False
    
18.     Set Rng = ActiveSheet.Range("$A$1:$Q$300")
    
19.     Rng.Parent.AutoFilterMode = False   'Åã¥Ü¥þ³¡¸ê®Æ ->·sªº ¦h­«¿z¿ï ¤~·|½T.
    
20.     '¦h­«¿z¿ï  ..........
    
21.     For i = 1 To 6
    
22.         With Controls("ComboBox" & i)
    
23.             If .Value <> "" Then
    
24.                 Rng.AutoFilter Field:=i, Criteria1:=.Value & "*" '
    
25.             End If
    
26.         End With
    
27.     Next
    
28.     Application.ScreenUpdating = True
    
29. End Sub
    
30. Private Sub CommandButton4_Click()
    
31.     With ActiveSheet.Range("$A$1:$Q$300") '½d³ò
    
32.         .Parent.AutoFilterMode = False   'Åã¥Ü¥þ³¡¸ê®Æ ->¨ú®ø ¦h­«¿z¿ï
    
33.     End With
    
34. End Sub

½Æ»s¥N½X

sillykin

G¤jª©¥D§A¦n..¤£¦n·N«ä..¥t¦³¤@­Ó¤p°ÝÃD·Q½Ð±Ð..¦p¹Ï©Ò¥Ü :