[µo°Ý] ¦³±ø¥óªº²Î­p

gctsai

½Ð°Ý¦U¦ì¤j¤j:
§Ú¦³¤@­Ó¤u§@ªí¦p¤U(SHEET1)

¤U¸ü (23.72 KB)

2011-7-20 22:45

§Ú»Ý­n²Î­pA¤½¥qªº«~¦W¤Î¼Æ¶q¦p¤U(SHEET2)

¤U¸ü (10.61 KB)

2011-7-20 22:49

­n¦p¦ó°µ©O?

Andy2483

¦^´_ 24# gctsai


    ÁÂÁ½׾Â,ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨ÒÀÉ
«á¾ÇÂǦ¹©«¬ã¨s¸ê®Æªí±Æ§Ç«á¤~±a¤J°}¦C,¸ê®Æªí´_­ì,±µµÛ¤~¶i¦æ²Î­p,
¾Ç²ß¨ì«Ü¦hª¾ÃÑ,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

¨Ó·½ªí:

¤U¸ü (101.01 KB)

2023-3-31 16:15

²Î­pªí:µ²ªG

¤U¸ü (93.59 KB)

2023-3-31 16:16

Option Explicit
Sub «Å§i()
Dim Brr, Crr, Y, N&, C&, R&, i&, j&, T$, T2$, T3$, TT$
Dim Sh1 As Worksheet, Sh2 As Worksheet
Set Y = CreateObject("Scripting.Dictionary")
Set Sh1 = Sheets("¨Ó·½"): Set Sh2 = Sheets("²Î­p")
C = Sh1.UsedRange.Columns.Count: R = Sh1.UsedRange.Rows.Count
With Range(Sh1.[A1], Sh1.Cells(R, C + 1))
   With .Columns(C + 1): .Value = "=ROW(A1)": .Value = .Value: End With
   .Sort KEY1:=.Item(3), Order1:=1, Key2:=.Item(2), Order2:=1, Header:=1
   Brr = .Value
   .Sort KEY1:=.Item(C + 1), Order1:=1, Header:=1: .Columns(C + 1).Delete
End With
For i = 2 To UBound(Brr)
   T = Brr(i, 3): If Y(T) = "" Then Y(T) = Y.Count: Y(T & "|Àx¦ì¼Æ") = ""
Next
Sh2.UsedRange.Delete
With Sh2.[A1].Resize(1, Y.Count)
   .Value = Y.keys: .Replace "*|", "", Lookat:=xlPart
End With
ReDim Crr(1 To R, 1 To Y.Count)
For i = 2 To UBound(Brr)
   T2 = Brr(i, 2): T3 = Brr(i, 3): TT = T3 & "|" & T2
   If Y(TT) = "" Then
      Y(T3 & "/r") = Y(T3 & "/r") + 1
      Crr(Y(T3 & "/r"), Y(T3)) = T2
      Crr(Y(T3 & "/r"), Y(T3) + 1) = 1
      Y(TT) = 1
      Else
         N = Y(T3 & "/r")
         Crr(N, Y(T3) + 1) = Crr(N, Y(T3) + 1) + 1
   End If
Next
With Sh2.[A2].Resize(UBound(Crr), UBound(Crr, 2))
   .Value = Crr: .EntireColumn.AutoFit
End With
Set Y = Nothing: Erase Brr, Crr: Set Sh1 = Nothing: Set Sh2 = Nothing
End Sub

h60327

gbkeeª©¥D¸ÑÄÀªº¦n²M·¡
¤S¾Ç·|¤F·sÆ[©À

wsx24680

D(Rng.Offset(, 1).Value) = D(Rng.Offset(, 1).Value) + 1

¨S·Q¨ìÁÙ¯à³o¼Ë¥Î
¤S¾Ç¨ì¤F¡A·PÁÂ

gctsai

ÁÂÁ¦U¦ì¤j¤jªº«ü¾É,²×©ó§¹µ½¤F

oobird

¦^´_ 29# am0251


    http://forum.twbts.com/thread-20-1-1.html

am0251

¤£¦n·N«ä,GBKEE¤j¤j,¥i¥H¸ÑÄÀ¤@¤U"SCRIPTING.DICTIONARY"ªº¥Îªk©O?³o­Ó§ÚÁÙ¨S¾Ç¹L,ÁÂÁÂ!

GBKEE

¦^´_ 26# gctsai
­×§ï¦p¤U´N¥²¥h­pºâÄæ¦ì¤F

1. Sub Ex()
   
2.     Dim D As Object, Rng As Range, f As Variant
   
3.     Set D = CreateObject("SCRIPTING.DICTIONARY") '³]¥ß¦r¨åª«¥ó
   
4.     With Sheets("¨Ó·½")
   
5.         Set Rng = .[c2]    '³]¥ßÀx¦s®æª«¥ó
   
6.         f = Application.Match(Sheets("²Î­p").[b1].Text, .Rows(1), 0) 'f: ¦b¨Ó·½¤¤´M§ä²Î­pªºÄæ¦ì
   
7.         If IsError(f) Then MsgBox "²Î­pªºÄæ¦ì¤£¦s¦b!!!": Exit Sub
   
8.         Do While Rng <> ""        'Rngªº­È¬°ªÅ¥Õ®É¤£°õ¦æ Doªº°j°é
   
9.            If Rng = Sheets("²Î­p").Range("A2") Then D(.Cells(Rng.Row, f).Value) = D(.Cells(Rng.Row, f).Value) + 1
   
10.             '        .[A2] ->Sheets("²Î­p")[A2]      '¦r¨åª«¥ó(KEY)=ITEM + 1
    
11.             Set Rng = Rng.Offset(1)  'Rng¤U²¾¤@¦C¦ì
    
12.         Loop
    
13.     End With
    
14.     With Sheets("²Î­p").[B2:C2]
    
15.         .Resize(.CurrentRegion.Rows.Count, 2) = ""
    
16.         .Cells(1).Resize(D.Count) = Application.Transpose(D.KEYS)
    
17.         .Cells(2).Resize(D.Count) = Application.Transpose(D.ITEMS)
    
18.         .Resize(D.Count, 2).Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo
    
19.     End With
    
20.     Set D = Nothing
    
21.     Set Rng = Nothing
    
22. End Sub

½Æ»s¥N½X

sonynetmd

½Ð°Ý¦U¦ì¤j¤j, ¦pªG­pºâ"¼Æ¶q"¥i§_¤£¬O§Q¥Îµ¥©ó¸¹(=) µ´¹ï­È {0,1,2...}, ¦Ó§ï¬° ¤j©ó/¤p©ó ¥i¥H¶Ü?
¤p¾Ç¥Í sony

gctsai

¦^´_ 25# GBKEE

   ±q AÄæ²¾¨ìCÄæ­n¥[ f=f-2
   ¨º±qAÄæ²¾¨ìEÄæ¬O¤£¬O­n¥[ F=F-4
   ¤]´N¬O¦pªG²¾¦h¤ÖÄæ´N­n´î¦^¨Ó¶Ü??