- ©«¤l
- 522
- ¥DÃD
- 36
- ºëµØ
- 1
- ¿n¤À
- 603
- ÂI¦W
- 0
- §@·~¨t²Î
- win xp sp3
- ³nÅ骩¥»
- Office 2003
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2012-12-13
- ³Ì«áµn¿ý
- 2021-7-11
|
ªá¤F¤£¤Ö®É¶¡, Á`ºâ¹ï Ditionary ¦³¤@ÂIÂI¤F¸Ñ,
d(a.Value) = "" »P
If Not exists(a.Value) Then d.Add a.Value, "" ¦P¸q.
¤U¦Cקï¦Û 15# GBKEEª©¤jªºVBA(ª©¤jªº°õ¦æµ²ªG§¹¥þ¥¿½T),
½Ð«ü±Ð!!- 'קï¦Û 15# GBKEEª©¤jªºVBA
- Sub Test()
- Dim d As Object, d2 As Object, AR(1 To 3), ArC()
- Dim M As Variant, E As Variant
- Dim LstA As Integer, LstB As Integer, Cnt As Integer, Cnt2 As Integer
- Dim i As Integer, J As Integer
- Set d = CreateObject("SCRIPTING.DICTIONARY")
- Set d2 = CreateObject("SCRIPTING.DICTIONARY")
- Range("C:G").ClearContents '²M°£¤u§@ªí4 CÄæ-->GÄæ
- Range("E:E").Interior.ColorIndex = xlNone
- LstB = [B65536].End(xlUp).Row
- Cnt = 1
- Cnt2 = 1
- ArC = Array(35, 36, 37, 38)
-
- '¥H¤Upºâ ¤u§@ªí1-> ¤u§@ªí3 ¥X²{¾÷²v¬°80%ªº¦r¥À*****
- For i = 1 To 3 '±q "¤u§@ªí1" ¨ì "¤u§@ªí3"
- Sheets(i).Range("C:E").ClearContents '²M°£¨C¤@¶ªº CÄæ-->EÄæ
- With Sheets(i).[C1].Resize(Sheets(i).[B65536].End(xlUp).Row) '§Y[C1:Cxx]
- .Cells = "=COUNTIF(C2,RC[-1])/COUNTA(C1)"
- '[C1]¤½¦¡ = COUNTIF(B:B,B1)/COUNTA(A:A), §Ypºâ¨CÓ¦r¥À¥X²{ªº¾÷²v
-
- AR(i) = Application.Transpose(.Offset(, -1).Resize(, 2).Value)
- '±N BÄæ,CÄæ Âà¸m¬° AR(1 to 2, 1 to 21)
-
- '±N^¤å¦r¥À¥X²{¦Ê¤À¤ñ¾÷²v¾É¤J AR(i)
- For Each E In .Cells '¾ú¹M¨C¤@¶ªº [C1:Cxx]
- d2.Item(E.Offset(, -1).Value) = E.Value
- '±N¦r¥À(Key)¤Î¾÷²v(Item)¥þ³¡¦s¤J ¦r¨åd2 ¤¤(¤£½×¾÷²v¤j¤p)
-
- If E >= 0.8 Then d(E.Offset(, -1).Value) = E.Value
- '±N¾÷²v >=80% ªº¦r¥À¤Î¾÷²v, ©ñ¨ì ¦r¨åd ¤¤
- Next
-
- .Cells = .Value '¤½¦¡ÂରÈ
-
- If d.Count >= 1 Then
- .Cells(1).Range("B1").Resize(d.Count) = Application.Transpose(d.keys) '¶É˦r¥À¨ì¨C¶ªº [D1:Dxx]
- .Cells(1).Range("C1").Resize(d.Count) = Application.Transpose(d.Items) '¶É˾÷²v¨ì¨C¶ªº [E1:Exx]
- '¡¹³o¸ÌY±N .Range("B1") §ï¬° .[B1]
- ' «h·|¥X²{ "ª«¥ó¤£¤ä´©ÄݩʩΤèªk" ªº¿ù»~!!
- End If
-
- If d2.Count >= 1 Then
- '©T©w¦¡(¤u§@ªí4ªºAÄæ¤ÎBÄ檺ªí®æ¨Æ¥ý¶ñ¦n)
- '***¤u§@ªí4¤W BÄæ¦ì¤¤¡A¨CÓ^¤å¦r¥À¥X²{¦b«ü©w¤u§@ªíªº¤ñ²v***
- M = Application.Match(Sheets(i).Name, [A:A])
- If IsNumeric(M) Then
- If i = 3 Then
- LstA = LstB
- Else
- LstA = Cells(M, 1).End(xlDown).Row - 1
- End If
- For J = M To LstA
- If d2.Exists(Cells(J, 2).Value) Then
- Cells(J, 3) = d2(Cells(J, 2).Value)
- End If
- Next
- Cnt = LstA + 1
- End If
-
- '¾÷°Ê¦¡(EÄæ(¤u§@ªí¦WºÙ)¤ÎFÄæ(¦r¥À)ªºªí®æ¥ÑVBA¶ñ¤J)
- '***¤u§@ªí4¤W FÄæ¦ì¤¤¡A¨CÓ^¤å¦r¥À¥X²{¦b«ü©w¤u§@ªíªº¤ñ²v***
- Cells(Cnt2, 5) = Sheets(i).Name '¤u§@ªí¦WºÙ
- Cells(1).Range("E" & Cnt2).Resize(d2.Count).Interior.ColorIndex = ArC(i)
- Cells(1).Range("F" & Cnt2).Resize(d2.Count) = Application.Transpose(d2.keys) '¶É˦r¥À
- Cells(1).Range("G" & Cnt2).Resize(d2.Count) = Application.Transpose(d2.Items) '¶É˾÷²v
- Cnt2 = d2.Count + 1
- End If
- End With
- d.RemoveAll
- d2.RemoveAll
- Sheets(i).Range("C:C", "E:E").NumberFormatLocal = "0%" '¼Æ¦r®æ¦¡¤Æ
- Next
- Range("C:C", "G:G").NumberFormatLocal = "0%" '¼Æ¦r®æ¦¡¤Æ
- End Sub
½Æ»s¥N½X |
|