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

¤j¶q¸ê®Æ¤ñ¹ï­pºâ¤Î±Æ¦W

¥»©«³Ì«á¥Ñ oak0723-1 ©ó 2022-5-17 09:16 ½s¿è

¦^´_ 10# samwang


    ¥ý¶i§A¦n
§Ú±N¤u§@ªí01ªºI5:I1005¶ñ¤J¸ê®Æ1¸U¦C¸ê®Æ,°õ¦æ¨S¦h¤[´NÅã¥Ü"¨S¦^À³",§Ú·QÀ³¸Ó¬O·í¤F
«á¨Ó§Ú¤@ª½§R´î¤u§@ªí01ªºI5:I1005¸ê®Æ¦C¼Æ´ú¸Õ°õ¦æ,µo²{³Ñ2¤d¦C¯Ó¬ù15¤ÀÁ駹¦¨
¤£ª¾¬O§_°õ¦æ³t«×®Ä¯à¬O§_¦³¿ìªk¤©¥H´£¤É?

(1110516-1)¤ñ¹ïtest_0516(1¸U¦C).part01.rar (1 MB)

(1110516-1)¤ñ¹ïtest_0516(1¸U¦C).part02.rar (1 MB)

(1110516-1)¤ñ¹ïtest_0516(1¸U¦C).part03.rar (1 MB)

(1110516-1)¤ñ¹ïtest_0516(1¸U¦C).part04.rar (1 MB)

(1110516-1)¤ñ¹ïtest_0516(1¸U¦C).part05.rar (1 MB)

(1110516-1)¤ñ¹ïtest_0516(1¸U¦C).part06.rar (1 MB)

(1110516-1)¤ñ¹ïtest_0516(1¸U¦C).part07.rar (236.24 KB)

TOP

¥»©«³Ì«á¥Ñ samwang ©ó 2022-5-17 11:15 ½s¿è
¦^´_  samwang


    ¥ý¶i§A¦n
§Ú±N¤u§@ªí01ªºI5:I1005¶ñ¤J¸ê®Æ1¸U¦C¸ê®Æ,°õ¦æ¨S¦h¤[´NÅã¥Ü"¨S¦^À³",§Ú ...
oak0723-1 µoªí©ó 2022-5-17 09:12


¤w§ó·s¡A4¸U¦hµ§¬ù12¬í¡AÀɮפӤj66M¤£¤W¶Ç¡A½Ð¦Û¦æ«Ø¸ê®Æ«á¦A´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
¥t¥~¡A¥Î§Aªº#11ªþ¥óÀÉ®×¥h°õ¦æ·|¶]«Ü¤[(·í±¼)¡A­««Ø¸ê®Æ¼Æ¾Ú¡A«Øij¼Æ­ÈÂର­È¤£­n®Ø½uµM«á¦A°õ¦æµ{¦¡(¦p¹Ï¤ù)

Sub test()
Dim Ar_in, Arr, Arr1, Brr(), Crr(), xD, T, T1, n&, i&, j&, R&, sh%, MaxR&
Set xD = CreateObject("Scripting.Dictionary")
Tm = Timer
Ar_in = Sheets("¿é¤J").Range("i3:in3")
For sh = 2 To Sheets.Count
    With Sheets(sh)
        .Range("i3").Resize(1, UBound(Ar_in, 2)) = Ar_in
        R = .[b65536].End(3).Row: If R < 2 Then GoTo 95
        Arr1 = .Range("b4:b" & R): Arr = .Range("i3:in" & R)
        ReDim Brr(1 To UBound(Arr), 1 To UBound(Arr, 2)) 'IT3:RY
        ReDim Preserve Crr(1 To 100000, 1 To sh - 1)     '¿é¤Jªº²Î­p
        If MaxR < UBound(Arr) Then MaxR = UBound(Arr)
        Crr(1, sh - 1) = .Name
        For i = 3 To UBound(Arr)
            For j = 1 To UBound(Arr, 2)
                T = Arr(i, j): T1 = Arr(1, j)
                If T1 = "" Then GoTo 90
                If T1 = T Then
                    Brr(i - 2, j) = 1: n = n + 1
                Else
                    Brr(i - 2, j) = 0
                End If
90:         Next j
            Crr(i - 1, sh - 1) = n: n = 0
95:    Next i
        .[it5].Resize(UBound(Brr), UBound(Brr, 2)) = Brr
    End With
Next
n = 0
With Sheets(1)
    .[i4:r4].NumberFormatLocal = "@"
    .[i4].Resize(MaxR, UBound(Crr, 2)) = Crr
    With .[s5].Resize(MaxR - 2)
            .Formula = "=Sum(i5:r5)": .Value = .Value
    End With
    With Range([s5], [s4].End(4))
        Arr = .Value
        .Sort Key1:=.Item(1), Order1:=2, Header:=2
        Brr = .Value: .Value = Arr
    End With
    For i = 1 To UBound(Brr)
        T = Brr(i, 1): If Not xD.Exists(T) Then n = n + 1: xD(T) = n
    Next
    For i = 1 To UBound(Arr): Arr(i, 1) = xD(Arr(i, 1)): Next
    .[t5].Resize(UBound(Arr)) = Arr
End With
MsgBox Timer - Tm
End Sub

TOP

¦^´_ 12# samwang


    ÁÂÁÂ
§¹¥þ²Å¦X§Úªº§Æ±æ
ÁÂÁ§A

TOP

¥»©«³Ì«á¥Ñ singo1232001 ©ó 2022-5-21 06:35 ½s¿è

¦^´_ 13# oak0723-1

excel 2019
2017¦~ªº¹q¸£  r7-1700x  °O¾ÐÅé3000 cpu99%

10­¶ ¦@40¸Uµ§ 36¬í

Àɮפj¤p 336MB
https://drive.google.com/file/d/1dRNroDrAKxhnoKg9qp9IJhO7pemwGh6j/view?usp=sharing

¦hªº³¡¤À³£§R¤F  IN ¥kÃ䪺³£§R¤F  ¤ÓÃe¤j

­n¤j¶q¸ê®Æ ´N­nºÉ¶q¤£¥Î¥ô¦óÃC¦â®æ¦¡

(1110516-1)¤ñ¹ïtest_0516(1¸U¦C)v1.zip (591.62 KB)

TOP

¦^´_ 14# singo1232001


    ¦¬¨ì
·P®¦
:)

TOP

¥»©«³Ì«á¥Ñ oak0723-1 ©ó 2022-5-21 08:54 ½s¿è

¦^´_ 14# singo1232001


  ©êºp
§Ú­è´ú¸Õµo²{´X­Ó°ÝÃD

´N¬O·í¦b¤u§@ªí"¿é¤J" L3Àx¦s®æ¿é¤J4001(¦p¹Ï01)
¦Ó¤u§@ªí01-10ªºÀx¦s®æL3«o¨S¦³¸òµÛ§ïÅÜ(¹Ï02)
©Ò¥H¤ñ¹ïµ²ªG¤]¦³°ÝÃD(¦p¹Ï03)
¤u§@ªí01-10¨S¦³¤ñ¹ïµ²µ²ªG(¦p¹Ï04)

¹Ï¤ù01.jpg (110.28 KB)

¹Ï¤ù01.jpg

¹Ï¤ù 02.jpg (107.54 KB)

¹Ï¤ù 02.jpg

¹Ï¤ù 03.jpg (130.31 KB)

¹Ï¤ù 03.jpg

¹Ï¤ù04.jpg (197.9 KB)

¹Ï¤ù04.jpg

TOP

¥»©«³Ì«á¥Ñ singo1232001 ©ó 2022-5-21 15:52 ½s¿è

¦^´_ 16# oak0723-1

§ï¦n¤F ·|¦bµ{§Ç¸Ì§ó·s
¤£¹Lªí¤W¤£Åܧ󠠭Y·Q­n¥Î=¸¹§ó·s01~10[I3~IN3] ÀÉ®×·|ÅܺC  
¥Ø«e01~10[I3:IN3]¬Æ¦Ü§R±¼¤]¥i¥H


    Sub test()
TT = Timer
Set sh0 = Sheets("¿é¤J")
ReDim ar(1 To Sheets.Count - 1): w = 1
ReDim ar0(1 To Sheets.Count - 1)
ReDim ar1(1 To Sheets.Count - 1)
sh0.[i5:T1048576].ClearContents
For Each Z In Sheets
If Z.Name <> "¿é¤J" Then
ar(w) = Z.Range("I5:IN" & Z.Cells(Rows.Count, 2).End(3).Row)
  ar0(w) = sh0.[I3:IN3]
   ReDim ir(1 To UBound(ar(w)), 0)
   ar1(w) = ir
    If MaxR < UBound(ar(w)) Then MaxR = UBound(ar(w))
     w = w + 1
End If
Next

ReDim ar2(1 To MaxR, 0)
For i = 1 To MaxR: ar2(i, 0) = 0: Next

For i = 1 To UBound(ar)
    For j = 1 To UBound(ar(i))
        For k = 1 To 240
        If ar(i)(j, k) = ar0(i)(1, k) Then
        ar1(i)(j, 0) = ar1(i)(j, 0) + 1
        ar2(j, 0) = ar2(j, 0) + 1
        End If
        Next
    Next
Next

For i = 1 To UBound(ar)
sh0.Cells(5, i + 8).Resize(UBound(ar1(i)), 1) = ar1(i)
Next
sh0.[s5].Resize(UBound(ar2), 1) = ar2

Set d = CreateObject("scripting.dictionary"): d.RemoveAll
For i = 1 To UBound(ar2): d(ar2(i, 0)) = "": Next: d0 = d.keys()
  For i = 0 To d.Count - 1
    For j = i + 1 To d.Count - 1
      If d0(i) < d0(j) Then tp = d0(i): d0(i) = d0(j): d0(j) = tp
    Next j:  Next i
ReDim d1(0 To d0(0))
For i = 0 To UBound(d0): d1(d0(i)) = i + 1: Next
  For i = 1 To UBound(ar2): ar2(i, 0) = d1(ar2(i, 0)): Next
   sh0.[T5].Resize(UBound(ar2), 1) = ar2
   
sh0.[A1] = Format(Timer - TT, "0.0")
End Sub

TOP

¦^´_ 17# singo1232001


    ©êºp,º|¤F1­Ó°ÝÃD
1.¿é¤JÄæ¦ì­Y¬OªÅ¥Õ,´N¤£¤ñ¹ï,©Ò±oªº­È´N¬O0(¦p¹Ï)
2.¿é¤JÄæ¦ì­Y¬O0,¤ñ¹ïÄõÄæ¦ì­Y¬OªÅ¥Õ,©Ò±oªº­È¤]¬O0(¦p¹Ï)

¹Ï¤ù 000.jpg (79.12 KB)

¹Ï¤ù 000.jpg

TOP

¦^´_ 12# samwang

©êºp,º|¤F1­Ó°ÝÃD
1.¿é¤JÄæ¦ì­Y¬OªÅ¥Õ,´N¤£¤ñ¹ï,©Ò±oªº­È´N¬O0(¦p¹Ï)
2.¿é¤JÄæ¦ì­Y¬O0,¤ñ¹ïÄõÄæ¦ì­Y¬OªÅ¥Õ,©Ò±oªº­È¤]¬O0(¦p¹Ï)

¹Ï¤ù 000.jpg (79.12 KB)

¹Ï¤ù 000.jpg

TOP

¥»©«³Ì«á¥Ñ singo1232001 ©ó 2022-5-21 17:27 ½s¿è

¦^´_ 19# oak0723-1

´ú¸Õ¬Ý¬Ý

    Sub test()
TT = Timer
Set sh0 = Sheets("¿é¤J")
ReDim ar(1 To Sheets.Count - 1): w = 1
ReDim ar0(1 To Sheets.Count - 1)
ReDim ar1(1 To Sheets.Count - 1)
sh0.[i5:T1048576].ClearContents
For Each Z In Sheets
If Z.Name <> "¿é¤J" Then
ar(w) = Z.Range("I5:IN" & Z.Cells(Rows.Count, 2).End(3).Row)
  ar0(w) = sh0.[I3:IN3]
   ReDim ir(1 To UBound(ar(w)), 0)
   ar1(w) = ir
    If MaxR < UBound(ar(w)) Then MaxR = UBound(ar(w))
     w = w + 1
End If
Next

ReDim ar2(1 To MaxR, 0)
For i = 1 To MaxR: ar2(i, 0) = 0: Next

For i = 1 To UBound(ar)
    For j = 1 To UBound(ar(i))
        For k = 1 To 240
        If ar0(i)(1, k) <> "" Then
            If ar(i)(j, k) = ar0(i)(1, k) Then
            ar1(i)(j, 0) = ar1(i)(j, 0) + 1
            ar2(j, 0) = ar2(j, 0) + 1
            End If
        End If
        Next
    Next
Next

For i = 1 To UBound(ar)
sh0.Cells(5, i + 8).Resize(UBound(ar1(i)), 1) = ar1(i)
Next
sh0.[s5].Resize(UBound(ar2), 1) = ar2

Set d = CreateObject("scripting.dictionary"): d.RemoveAll
For i = 1 To UBound(ar2): d(ar2(i, 0)) = "": Next: d0 = d.keys()
  For i = 0 To d.Count - 1
    For j = i + 1 To d.Count - 1
      If d0(i) < d0(j) Then tp = d0(i): d0(i) = d0(j): d0(j) = tp
    Next j:  Next i
ReDim d1(0 To d0(0))
For i = 0 To UBound(d0): d1(d0(i)) = i + 1: Next
  For i = 1 To UBound(ar2): ar2(i, 0) = d1(ar2(i, 0)): Next
   sh0.[T5].Resize(UBound(ar2), 1) = ar2
   
sh0.[A1] = Format(Timer - TT, "0.0")
End Sub

TOP

        ÀR«ä¦Û¦b : ¤£©È¨Æ¦h¡A¥u©È¦h¨Æ¡C
ªð¦^¦Cªí ¤W¤@¥DÃD