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

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

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

¤u§@ªí"Á`ªí"ªº¸¹¬O¨ú¦U¤u§@ªí­«½Æªº­È¡B´Á­­«h¬O¤u§@ªí¦WºÙ
¥Ø«e¤wª¾Worksheet.Name=¤u§@ªí¦WºÙ
¨ä¾l©|¦b§V¤O¬ã¨s¤¤¡A¨D¸Ñ·PÁ¡I

¸Ô¦pªþ¥ó(¤U)
Á`ªí­«½Æ.rar (19.88 KB)

¦^´_ 1# av8d

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

TOP

¦^´_ 2# samwang

¥Ñ°J·PÁ«e½úªºÀ°§U¡A§Ú¤]§V¤O¬ã¨s¾Ç²ß¤¤¡A¨Ã¼Ð¥Ü¤Fµù¸Ñ¡A¤£ª¾¹D¬O§_¦³»~¡AÁٽФj¤j¦³ªÅ¦A¬Ý¡AÁÂÁ¡I
  1.     Dim Arr, xD, Brr(1 To 1000, 1 To 2), i&, n%, sh% '«Å§iÅܼÆ
  2.     Set xD = CreateObject("Scripting.Dictionary") '³]©wxD¬°¦r¨åª«¥ó
  3.     For sh = 2 To Sheets.Count '¤u§@ªí2~¤u§@ªíÁ`¼Æ,For°j°ésh(«Å§i¬°int)
  4.         With Sheets(sh) '¶i¤J¤u§@ªí,¥Hsh¥N¤J
  5.             Arr = .[a1].CurrentRegion '¿ï¨úa1¥]§t¾Fªñªº©Ò¦³½d³ò,Arr¬°²Õ¼Æ
  6.             For i = 2 To UBound(Arr) '²Ä2¦C~Arrªº¦C¤W­­,For°j°éi(«Å§i¬°Long)
  7.                 If xD.Exists(Arr(i, 1)) Then '¦C¬OÅܰʪº¡AAÄæ¬O©T©wªº¡Ai¥N¤J¦C¡A§PÂ_¦r¨å¸Ìªºkey¦³¨S¦³Arr(i, 1)¡A¦pªG¦³´N©¹¤U°µ
  8.                     If Not xD.Exists(Arr(i, 1) & "|" & Sheets(sh).Name) Then '¦pªG¦r¨å¸Ìªºkey¨S¦³Arr(i, 1)´N¦s¤J¦r¨å¸Ì¡A³s¦P¤u§@ªí¦WºÙ
  9.                         n = n + 1: Brr(n, 1) = Arr(i, 1) '±NArr(i, 1)­«½Æªº¸ê®Æ¦sµ¹Brr(n, 1)
  10.                         Brr(n, 2) = Sheets(sh).Name '±NArr(i, 1)­«½Æ®Éªº¤u§@ªí¦WºÙ¦s¤JBrr(n, 2)
  11.                     End If
  12.                     xD(Arr(i, 1) & "|" & Sheets(sh).Name) = "" '¦pªG¦r¨å¸Ìªºkey¦³Arr(i, 1)´N¦s¤J¦r¨å¸Ì¡A³s¦P¤u§@ªí¦WºÙ
  13.                 Else '§PÂ_¦r¨å¸Ìªºkey¦³¨S¦³Arr(i, 1)¡A¦pªG¨S¦³´N©¹¤U°µ
  14.                     xD(Arr(i, 1)) = "" '±NArr(i, 1)¦s¤J¦r¨å¸Ì
  15.                 End If
  16.             Next
  17.         End With
  18.         xD.RemoveAll '²MªÅ¦r¨å¤¤ªº¼Æ¾Ú
  19.     Next
  20.     If n > 0 Then '¦pªG¦³§ä¨ì­«½Æªº¸ê®Æ©¹¤U°µ
  21.         With Sheets("Á`ªí")
  22.             .[a1].CurrentRegion.Offset(1) = "" '²MªÅA¡BBÄæ¼Æ¾Ú¡A«O¯d¼ÐÃD
  23.             .Range("a2").Resize(n, 2) = Brr '±NBrr²Õ¼ÆÄÀ©ñ¨ìA¡BBÄæ
  24.         End With
  25.     End If
½Æ»s¥N½X

TOP

¦^´_ 3# av8d


¼g±oµù¸Ñ«Ü²M·¡«Ü¦n¡A³£¥¿½T¡A¤¬¬Û¾Ç²ß§V¤O¦¨ªø¡A·PÁÂ

TOP

Sub ¥¨¶°1()
Dim Arr, Brr(1 To 1000, 1), xD, S As Worksheet, SN$, i&, T$, N&
Set xD = CreateObject("Scripting.Dictionary")
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):  xD(T) = xD(T) + 1
        If xD(T) = 2 Then N = N + 1: Brr(N, 0) = T: Brr(N, 1) = SN: xD(T) = -9 ^ 9
    Next i
    xD.RemoveAll
x01: Next
With Sheets("Á`ªí")
    .[a1].CurrentRegion.Offset(1).ClearContents
    If N > 0 Then .[a2].Resize(N, 2) = Brr
End With
End Sub

TOP

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


    «D±`·PÁª©¥D©âªÅÆ[¬Ý§Úªº°ÝÃD¡A¤]Åý§Ú¹ïµ{¦¡¤S§ó²`¤@¼hªº²z¸Ñ¡A
    ª©¥Dªºµª®×Åý§Ú¥i¥H§ó§Ö³t¦Û¦æ§ó§ï±ø¥ó¡AÅý§Ú¹ï©óÄYÂÔªºµ{¦¡½X¦³¶i¤@¨Bªº¾Ç²ß¡C

    °ß¿W¦³¤@¤p¬qµ{¦¡½XÁÙ¤£À´¡A§Æ±æª©¥D¯à¸Ñ´b¡A§Ú¤]«ùÄò¦bºô¸ô¤W´M§ä³o¬qªº¸Ñµª¡C
    xD(T) = -9 ^ 9

TOP

¦^´_ 6# av8d


-9^9=-387420489   -9ªº9¦¸¤è,
·í¹J¨ì­«ÂвĤG¦¸®É, ¨Ï¦r¨å±a­È -9^9,
°¸«á¦A¹J¨ì, ¦A«ç»ò¥[+1, ¤j¬ù¤£·|ÅÜ¥¿¼Æ~~

TOP

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


   ­ì¨Ó¦p¦¹¡Aª©¤jªº·N«ä¬OÅý´Nºâ¦A¦¸¹J¨ì§ó¦h¦¸­«½Æªº¡A¤]¤£·|¦]¬°³Q¦s©ñ¨ìBrr¤¤¡A¹ï¶Ü¡HÁÂÁª©¤j¡C

TOP

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


    ª©¥D±z¦n¡A§Ú¦Û§Ú½m²ß·s¼W¤F¶i¶¥ÃD¡A§ï¼g¤F¤@¤U¡A¦ý¬O¥X²{¿ù»~'424¡A¦¹³B»Ý­nª«¥ó¡C

    Á`ªí­«½Æ2.rar (26 KB)

   
    ¿ù»~µ{¦¡½X¡GBrr(N, 0) = Arr(i, 1).Resize(i, 3)

TOP

¦^´_ 9# av8d

resize ¦@¯à¥Î¦b rangeª«¥ó, array¤¤¥u¯à¶]°j°é³v¤@¼g¤J:

Sub ¥¨¶°3()
Dim Arr, Brr(1 To 1000, 1 To 4), xD, S As Worksheet, SN$, i&, j%, T$, N&
Set xD = CreateObject("Scripting.Dictionary")
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, 2):  xD(T) = xD(T) + 1
        If xD(T) = 2 Then
           N = N + 1: xD(T) = -9 ^ 9
           For j = 1 To 3: Brr(N, j) = Arr(i, j): Next
           Brr(N, 4) = SN
        End If
    Next i
    xD.RemoveAll
x01: Next
With Sheets("Á`ªí")
    .[a1].CurrentRegion.Offset(1).ClearContents
    If N > 0 Then .[a2].Resize(N, 4) = Brr
End With
End Sub

TOP

        ÀR«ä¦Û¦b : ­n§åµû§O¤H®É¡A¥ý·Q·Q¦Û¤v¬O§_§¹¬üµL¯Ê¡C
ªð¦^¦Cªí ¤W¤@¥DÃD