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

[µo°Ý] ½Ð°Ý¦p¦ó¤@个±ø¥ó¤Ç°t¦h个µ²ªG(¥h­«½Æ)

[µo°Ý] ½Ð°Ý¦p¦ó¤@个±ø¥ó¤Ç°t¦h个µ²ªG(¥h­«½Æ)

¥»©«³Ì«á¥Ñ hycn ©ó 2020-11-8 09:58 ½s¿è

½Ð°Ý¤@个条¥ó¤Ç°t¦h个结ªG¨Ã¥h­«½Æ
³o VBA Function ¨ç¼Æ­n¦p¦ó­×§ï
¦]¬°EÄæ³æ¤¸®æ±ø¥ó¤Ç°t¬O§Æ±æ¥h­«½Æ¨Ã¦³" , "²Å¸¹¹j¶}

¦b¦¹¥ý¨¥Á ~

¤@­Ó±ø¥ó¤Ç°t¦h­Óµ²ªG(¥h­«½Æ).rar (10.65 KB)

ÀH·NºÛ "EXCEL°g"  blog  ©Î http://blog.xuite.net/hcm19522/twblog[img][/img]
¤w¦¬¶°7000½g EXCEL¨ç¼Æ

TOP

¦^´_ 1# hycn


    Sub test()
    Dim arr, ´Ñ½L(1 To 2000, 1 To 2), i%
    Dim d As Object, d1 As Object
    Set d = CreateObject("scripting.dictionary")
    Set d1 = CreateObject("scripting.dictionary")
    arr = Range("b1", [a65536].End(xlUp))

    For i = 1 To UBound(arr)
        xR = arr(i, 1) & arr(i, 2)
        If d.Exists(arr(i, 1)) Then
            If d1.Exists(xR) Then GoTo 100
            ¦C = d(arr(i, 1))
            ´Ñ½L(¦C, 2) = ´Ñ½L(¦C, 2) & "," & arr(i, 2)
        Else
            k = k + 1
            d(arr(i, 1)) = k
            ´Ñ½L(k, 1) = arr(i, 1)
            ´Ñ½L(k, 2) = arr(i, 2)
        End If
        d1(xR) = arr(i, 1) & arr(i, 2)
100:    Next
    Range("D1").Resize(k, 2) = ´Ñ½L
End Sub

TOP

¦^´_ 1# hycn

Function abc(a As Range, b As Range, c$) As String
Dim Ta$, Tb$, TT$
If a.Count <> b.Count Then abc = "error": Exit Function
If c = "" Then Exit Function
For i = 1 To a.Count
    Ta = a(i, 1):  Tb = b(i, 1)
    If Ta <> c Or Tb = "" Then GoTo 101
    If InStr("," & TT & ",", "," & Tb & ",") = 0 Then TT = TT & "," & Tb  '¤ñ¹ïb¤å¦r¬O§_¤w¦s¦b¤_TT¦r¦ê¤¤
101: Next
abc = Mid(TT, 2)
End Function

TOP

        ÀR«ä¦Û¦b : «H¤ß¡B¼Ý¤O¡B«i®ð¤TªÌ¨ã³Æ¡A«h¤Ñ¤U¨S¦³°µ¤£¦¨ªº¨Æ¡C
ªð¦^¦Cªí ¤W¤@¥DÃD