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

[µo°Ý] ¦p¦ó¨ú¦h­Ó¤u§@ªí«DªÅ¥Õªº­È

¦^´_ 10# ­ã´£³¡ªL


    «D±`·PÁª©¥D©âªÅÀ°§U¸ÑÃD¡A
   «á­±µo²{©m¦W¦³¾÷·|­«½Æ¡A§Ú§ï¤FÂù¥DÁä  T = Arr(i, 2) & Arr(i, 3)
   ´N±Æ°£¤F¡A±o¨ì©Ò»Ý­nªºªí®æ¤º®e¡A¥i»¡¬O¨ü¯q¨}¦h¡C

TOP

¦^´_ 11# av8d


­Y­n³s±µ¤å¦r, ³Ì¦n¾i¦¨²ßºD¥["¤À¹j²Å¸¹"
¨Ò:
A  AA...."A" & "AA" = "AAA"
AA  A..."AA" & "A" = "AAA"
¨âªÌµLªk¤À¿ë, µø¬°¬Û¦P,
§ï¦¨:
A  AA...."A" & "|" & "AA" = "A|AA"
AA  A..."AA" & "|" & "A" = "AA|A"
§Y¥i²M·¡¤À¿ë®t²§, ÁöµM¹J¨ì¾÷·|¤£¦h, ¦ýÁÙ¬OÂÔ·V~~

TOP

¦^´_ 12# ­ã´£³¡ªL

    ÁÂÁª©¥D¤j¤j¡A­è¦n¤]Åý§Ú©ú¥Õ¤F¬°¤°»òsamwang«e½ú©Ò¨Ï¥Îªº
    Arr(i, 1) & "|" & Sheets(sh).Name ¤¤ªº "|" ­ì¦]¤F¡A
    ÄYÂÔªºµ{¦¡½X¯uªº«Ü­«­n¡A¤]¬O§Ú¤@ª½¯Ê¤Ö¥B¥²¶·¤£Â_¾Ç²ßªº¡I

TOP

¦^´_ 12# ­ã´£³¡ªL

­ã¤j±z¦n¡A
Ãö©óhttp://forum.twbts.com/viewthread.php?tid=21077
3¼Ó­ã¤jµoªíªº¤å³¹¤¤­n¦p¦ó¹F¦¨U>0¤ÎU<0¦b§Úªº°ÝÃD¤¤©O¡H
U>0  ­«½Æ®Éªº²Ä¤@µ§¸ê®Æ
U<0  ­«½Æ²Ä¤Gµ§¸ê®Æ¥H¤W

¥Ø«e¯à§ï¼gªº³¡¤À
xD(T) = 1  ¥h°£­«½Æ
xD(T) = 2  ­«½Æ²Ä¤Gµ§¸ê®Æ
xD(T) = 3  ­«½Æ²Ä¤Tµ§¸ê®Æ
xD(T) >1  ­«½Æ²Ä¤Gµ§¸ê®Æ
xD(T) >2  ­«½Æ²Ä¤Tµ§¸ê®Æ

¤£ª¾¦³¨S¦³¿ìªk§ï¼g¦¨­«½Æ®Éªº©Ò¦³¸ê®Æ¡A¤]´N¬OU>0©MU<0
¸Ô¦pªþ¥ó¡AÁ`ªí¬°µª®×¡AÁÂÁ­ã¤j


Á`ªí­«½Æ3.rar (26.42 KB)

TOP

¦^´_ 12# ­ã´£³¡ªL

    ª©¥D±z¦n¡A¥Ø«e¦³¸Ñ¶}¤@¥b¤F¡A

    U<0  ­«½Æ²Ä¤Gµ§¸ê®Æ¥H¤W¡A¤w³z¹LxD(T) <> 1¸Ñ¶}¤F¡A
    ¥u³Ñ¤UU>0  ­«½Æ®Éªº²Ä¤@µ§¸ê®Æ¡AÁÙ¨S·Q¥X¨Ó¤F¡AÄ~Äò§V¤O¤¤¡C

TOP

¦^´_ 15# av8d
½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
Sub test()
Dim Arr, xD, Brr(1 To 1000, 1 To 4), i&, n%, sh%, j%, T$
Set xD = CreateObject("Scripting.Dictionary")
For sh = 2 To Sheets.Count
    With Sheets(sh)
        Arr = .[a1].CurrentRegion
        For i = 2 To UBound(Arr)
            T = Arr(i, 1) & "|" & Arr(i, 2) & "|" & Arr(i, 3): xD(T) = xD(T) + 1
        Next
    End With
Next
For sh = 2 To Sheets.Count
    With Sheets(sh)
        Arr = .[a1].CurrentRegion
        For i = 2 To UBound(Arr)
            T = Arr(i, 1) & "|" & Arr(i, 2) & "|" & Arr(i, 3)
            If xD(T) > 1 Then
                n = n + 1: For j = 1 To 3: Brr(n, j) = Arr(i, j): Next
                Brr(n, 4) = Sheets(sh).Name
            End If
        Next
    End With
Next
If n > 0 Then
    With Sheets("Á`ªí")
        .[a1].CurrentRegion.Offset(1) = ""
        .Range("a2").Resize(n, 4) = Brr
    End With
End If
End Sub

TOP

«Øij¥Î16¼Ósamwang ¤jªº¤èªk...¥Î¨â¦¸°j°é~~

¥H¤U¨âºØ¥N½X¶È¨Ñ°Ñ¦Ò, Ãø¥H²z¸Ñ, ¤£·Q¦h°µ¸ÑÄÀ¤F!
Sub TEST_A1()
Dim Arr, Brr, Crr, xD, S As Worksheet, SN$, T$, U&, i&, j%, k&, N&, P%
Set xD = CreateObject("Scripting.Dictionary")
ReDim Brr(1 To 30000, 1 To 4): Crr = Brr
For Each S In Sheets
    Arr = S.[a1].CurrentRegion: SN = S.Name
    If Not SN Like "*#¤é" Then GoTo x01
    For i = 2 To UBound(Arr)
        T = Arr(i, 1) & "|" & Arr(i, 2) & "|" & Arr(i, 3)
        k = k + 1: Crr(k, 4) = SN: U = xD(T): P = 0
        If U > 0 Then N = N + 1: P = 1
        For j = 1 To 4
            If j < 4 Then Crr(k, j) = Arr(i, j)
            If U > 0 Then Brr(N, j) = Crr(U, j): xD(T) = -1
            If U < 0 Or P = 1 Then Brr(N + 1, j) = Crr(k, j)
        Next j
        If xD(T) = 0 Then xD(T) = k Else N = N + 1
i01: Next i
x01: Next
With Sheets("Á`ªí")
    .[a1].CurrentRegion.Offset(1).ClearContents
    If N > 0 Then .[a2].Resize(N, 4) = Brr
End With
End Sub

'============================
Sub TEST_A2()
Dim Arr, Brr, Crr, xD, S As Worksheet, SN$, T$, i&, j%, k&, N&
Set xD = CreateObject("Scripting.Dictionary")
ReDim Brr(1 To 30000, 1 To 4): Crr = Brr
For Each S In Sheets
    Arr = S.[a1].CurrentRegion: SN = S.Name
    If Not SN Like "*#¤é" Then GoTo x01
    For i = 2 To UBound(Arr)
        k = k + 1: Crr(k, 4) = SN: T = "": U = 0
        For j = 1 To 3
            T = T & "|" & Arr(i, j)
            Crr(k, j) = Arr(i, j)
        Next j
        If xD(T) = 0 Then xD(T) = k: GoTo i01
        If xD(T) > 0 Then U = xD(T): N = N + 1: xD(T) = -1
        For j = 1 To 4
            If U > 0 Then Brr(N, j) = Crr(U, j)
            Brr(N + 1, j) = Crr(k, j)
        Next
        N = N + 1
i01: Next i
x01: Next
With Sheets("Á`ªí")
    .[a1].CurrentRegion.Offset(1).ClearContents
    If N > 0 Then .[a2].Resize(N, 4) = Brr
End With
End Sub


'======================================

TOP

¦^´_ 17# ­ã´£³¡ªL


    samwang¤j¡A¸U¤À·PÁ¡A¤T­ÓÄ@±æ¤@¦¸º¡¨¬¡C

   1.¤£ª¾¬°¦ó­n¦s¨â¦¸¥DÁäµ¹¦r¨å¡H¥i¯à§Ú²z¸Ñ¦³»~
   2.RemoveAll­n¥[¦b­þ¥i¥HÅý¤u§@ªí¦U¦Û¿W¥ß§@·~

TOP

¦^´_ 17# ­ã´£³¡ªL


    §Ú¦^¿ù¤H¤F¡A©êºp¡Aª©¥DÁÂÁ§A¡A³o¨â­Ó§Ú·|¥J²Ó¬ã¨s¤F¡A¨ü¯q¨}¦h¡C

TOP

¦^´_ 19# av8d

¨â­Ó°j°é, ²Ä¤@¦¸¼g¤J¦r¨å, ²Ä¤G¦¸Åª¨ú¦r¨å, ¤]¥i°Ñ¦Ò¦p¤U:
Sub TEST_A3()
Dim Arr, Brr(1 To 3000, 1 To 5), Crr, xD, T$, i&, j%, k&, N&, x%
Set xD = CreateObject("Scripting.Dictionary")
For x = 2 To Sheets.Count
    Arr = Sheets(x).[a1].CurrentRegion
    For i = 2 To UBound(Arr)
        T = Arr(i, 1) & "|" & Arr(i, 2) & "|" & Arr(i, 3) '³s±µ¦r¦ê
        xD(T) = xD(T) + 1 '¨Ï¥Î¦r¨å²Ö­p¥X²{¦¸¼Æ
        k = k + 1:  Brr(k, 4) = Sheets(x).Name: Brr(k, 5) = T '¼È®É±N¦U¤u§@ªí¤º®e(§t¤u§@ªí¦WºÙ¤ÎT³s±µ¤å¦r)©ñ¤JBrr
        For j = 1 To 3: Brr(k, j) = Arr(i, j): Next
    Next i
Next
For i = 1 To k '¥HBrr¶]°j°é(¦¹®É¤£¶·¦A³v¤@Ū¨ú¤u§@ªí, ¦P®É´î¤Ö¤å¦r³s±µ°Ê§@, ¥[§Ö³t«×)
    If xD(Brr(i, 5)) > 1 Then N = N + 1 Else GoTo i01
    For j = 1 To 4: Brr(N, j) = Brr(i, j): Next '­«ÂЪº¥Ñ¤W¦Ó¤U¦A¦¸¼g¤JBrr
i01: Next i
With Sheets("Á`ªí")
    .[a1].CurrentRegion.Offset(1).ClearContents
    If N > 0 Then .[a2].Resize(N, 4) = Brr
End With
End Sub

TOP

        ÀR«ä¦Û¦b : ¦a¤WºØ¤Fµæ¡A´N¤£©öªø¯ó¡F¤ß¤¤¦³µ½¡A´N¤£©ö¥Í´c¡C
ªð¦^¦Cªí ¤W¤@¥DÃD