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

[µo°Ý] ³oºØ­«½Æ­È§R°£ªºVBA¸Ó¦p¦ó¼g(2003)

[µo°Ý] ³oºØ­«½Æ­È§R°£ªºVBA¸Ó¦p¦ó¼g(2003)

EXCEL¬°2003ª©¥»
¦pªGB¦C¦³­«½Æ´N§PÂ_C¦C¬O§_¤]¬Û¦P
¤£¦P«h¤£§R°£
B.C¬Ò¬Û¦P«h§R°£¦¹¦æ Á|¨Ò¦p¤U
    A     B    C
1  1   P1   B6
2  2   P1   B2
3  3   P1   B6
4  4   P2   B2
5  5   P5   B6

²Ä2¦æªºB¬°P1 »P²Ä1¦æªºB­È¬Û¦P¦ýC¤£¦P ¤£§R°£
²Ä3¦æªºB»PC©M²Ä1¦æªº¬Û¦P ¬G§R°£
½Ð°ÝVBA¸Ó¦p¦ó¼g~ÁÂÁÂ
³s§R°£BÄæ­«½Æ­È³£¼g¤£¥X¨Ó~...
¨Ò¤l¹Ï

¦^´_ 1# terrykyo520


    ¸Õ¸Õ¬Ý³o­Ó¬O§_²Å¦X»Ý­n
  1. Sub Test0()
  2.     Dim H&
  3.     Range("A2").Select
  4.     H = [A1].End(xlDown).Row
  5.     Range("$A$1:$C$" & H).RemoveDuplicates Columns:=Array(2, 3), Header:=xlYes
  6. End Sub
½Æ»s¥N½X

TOP

¦^´_ 2# Scott090


RemoveDuplicates³o¥u¦³2007¥H¤Wª©¥»¤~¥i¥Î
§Úªºª©¥»¬O2003ªº
ÁÂÁÂ

TOP

¦^´_ 3# terrykyo520


   ³o­ÓÀ³¨S¦³ª©¥»ªº°Ï§O
  1. Sub Test1()
  2.     Dim i&, j&
  3.     Dim aa, bb
  4.    
  5.     i = [A1].End(xlDown).Row
  6.     aa = Range("A2:C" & i).Value
  7.     For i = 1 To UBound(aa) - 1
  8.         For j = i + 1 To UBound(aa)
  9.             If aa(j, 2) = aa(i, 2) And aa(j, 3) = aa(i, 3) Then
  10.                 aa(j, 1) = "": aa(j, 2) = "": aa(j, 3) = ""
  11.             End If
  12.         Next
  13.     Next
  14.     ReDim bb(UBound(aa), 3)
  15.     j = 0
  16.     For i = 1 To UBound(aa)
  17.         If aa(i, 1) <> "" Then
  18.             j = j + 1
  19.             bb(j, 1) = aa(i, 1): bb(j, 2) = aa(i, 2): bb(j, 3) = aa(i, 3)
  20.         End If
  21.     Next
  22.     Range("A2").Resize(UBound(aa), 3).Clear
  23.     Range("A2").Resize(UBound(bb), 3) = bb

  24. End Sub
½Æ»s¥N½X

TOP

¥»©«³Ì«á¥Ñ terrykyo520 ©ó 2015-8-11 11:49 ½s¿è

¦^´_ 4# Scott090
§Ú®M¥Î¤U¥hµ²ªG©Ç©Çªº~·|ªÅ¤@¦æ¤S ¦A¤U¤@¦æA¦Cªº­È¶]¨ìB¥h B¦Cªº­È¶]¨ìC¦C C¦Cªº­È¤£¨£
¥i§_½ÐÀ°§Ú¨Ì³oTESTªºEXCEL¤U¥h¬Ý¬Ý©O~~ÁÂÁ±оÇ~
·Q­n°õ¦æ«áªºµ²ªG¦p¹Ï~¥ª°õ¦æ«e~¥k¬°°õ¦æ«á

TEST.rar (1.59 KB)

TOP

¦^´_ 5# terrykyo520


    ½Ð¦C¤@´Á±æªºµ²ªGªí¬O¤°»ò
³o¼Ë¤ñ¸û¦n³B²z

TOP

¦^´_ 5# terrykyo520
¸Õ¸Õ¡I
  1. Public Sub ex()
  2. Dim ar()
  3. arr = Range("a2:C" & Cells(Rows.Count, 1).End(xlUp).Row)
  4. k = UBound(arr)
  5. For i = 1 To UBound(arr) - 1
  6.     For j = i + 1 To UBound(arr)
  7.         If arr(i, 1) = "" Or arr(j, 1) = "" Then GoTo 10
  8.         If arr(i, 2) & arr(i, 3) = arr(j, 2) & arr(j, 3) Then
  9.             arr(j, 1) = ""
  10.             arr(j, 2) = ""
  11.             arr(j, 3) = ""
  12.             k = k - 1
  13.         End If
  14. 10:
  15.     Next
  16. Next

  17. ReDim ar(1 To k, 1 To 3)
  18. k = 1
  19. For i = 1 To UBound(arr)
  20.     If arr(i, 1) <> "" Then
  21.         ar(k, 1) = arr(i, 1)
  22.         ar(k, 2) = arr(i, 2)
  23.         ar(k, 3) = arr(i, 3)
  24.         k = k + 1
  25.     End If
  26. Next
  27. Range("a2:C" & Cells(Rows.Count, 1).End(xlUp).Row).Clear
  28. [a2].Resize(UBound(ar), 3) = ar
  29. End Sub
½Æ»s¥N½X

TOP

¦^´_ 1# terrykyo520
  1. Sub ex()
  2. Dim A As Range
  3. Set d = CreateObject("Scripting.Dictionary")
  4. For Each A In Range([B1], [B1].End(xlDown))
  5. If d.exists(A & A.Offset(, 1)) = False Then d(A & A.Offset(, 1)) = A.Offset(, -1).Resize(, 3).Value
  6. Next
  7. [A:C].ClearContents
  8. [A1].Resize(d.Count, 3) = Application.Transpose(Application.Transpose(d.items))
  9. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 5# terrykyo520


    µª®×¸ò§Aªº¥k¹Ï¤@¼Ë
test1.rar (9.04 KB)

TOP

ÁÙ¦³¤èªk¥i¸Õ
  1. Option Explicit
  2. Sub Ex()
  3.     Dim R As Range, Rng As Range
  4.     With ActiveSheet.UsedRange
  5.         .Columns("b:c").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
  6.         For Each R In .Rows
  7.             If R.Height = 0 Then
  8.                 If Rng Is Nothing Then
  9.                     Set Rng = R
  10.                 Else
  11.                     Set Rng = Union(Rng, R)
  12.                 End If
  13.             End If
  14.         Next
  15.     End With
  16.     Application.DisplayAlerts = False
  17.     If Not Rng Is Nothing Then Rng.Delete
  18.     Application.DisplayAlerts = True
  19. End Sub
  20. Sub Ex1()
  21.     Dim Sh As Worksheet, wb As Workbook
  22.     Set Sh = ActiveSheet
  23.     Sh.Copy
  24.     Set wb = ActiveWorkbook
  25.     With wb.Sheets(1)
  26.         .UsedRange.Columns("b:c").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
  27.         Sh.UsedRange.Clear
  28.         .UsedRange.Copy Sh.Range("A1")
  29.         .Parent.Close False
  30.     End With
  31. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

        ÀR«ä¦Û¦b : ¬°¦Û¤v§äÂǤfªº¤H¥Ã»·¤£·|¶i¨B¡C
ªð¦^¦Cªí ¤W¤@¥DÃD