ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

VBA°µ¿z¿ï

¦^´_  c_c_lai
.Replace E, "=XXX", xlWhole  ªº§@¥Î¦ó¦b¡H  ±N¸ê®Æ®w­n·j´Mªº¦r¦ê¤@¦¸Åܬ°µL®Äªº¤½¦¡(¿ù ...
GBKEE µoªí©ó 2013-9-1 15:53

ÁÂÁ±zªº¸àÄÀ¡A¦r­±¤W·N¸q§Ú³£¤F¸Ñ¡A
­ì¥»§Ú­nªº¬O¬°¦ó¦p¦¹³B­ù¡A¥H¤Î¥Î·N¡C
¸g¹ê»Ú Debug ²×©óÁA¸Ñ¹ê»Úªº¥©§®À³¥Î¡A
ÁÂÁ§A¡I

TOP

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

9999999999999999.JPG (77.08 KB)

9999999999999999.JPG

Àˬd­«ÂÐ.rar (18.39 KB)

TOP

¦^´_ 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
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

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§Ì¤£¤~..ÁÂÁÂ

TOP

¥»©«³Ì«á¥Ñ GBKEE ©ó 2013-9-4 10:36 ½s¿è

¦^´_ 18# sillykin
  1. Option Explicit
  2. Option Base 1  '<- ¤U­­­È¬° 1  ; ­Y­n³]¤U­­­È¬° 0¡A«h Option Base ³¯­z¦¡¬O¤£»Ý­nªº¡C

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

TOP

¦^´_  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????

TOP

¦^´_ 20# sillykin
¥i¨Ì¼Ëµe¸¬Äª¸Õ¸Õ¬Ý,¦³°ÝÃD¥i¦A´£°Ý(¦h½m²ßVBA·|¶i¨Bªº)
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 21# GBKEE


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

Àˬd­«ÂÐ.rar (25.86 KB)

TOP

¦^´_ 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


·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

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

TOP

        ÀR«ä¦Û¦b : ¡i¦æµ½­n¤Î®É¡j¦æµ½­n¤Î®É¡A¥\¼w­n«ùÄò¡C¦p¿N¶}¤ô¤@¯ë¡A¥¼¿N¶}¤§«e¤d¸U¤£­n°±º¶¤õ­Ô¡A§_«h­«¨Ó´N¤Ó¶O¨Æ¤F¡C
ªð¦^¦Cªí ¤W¤@¥DÃD