[µo°Ý] ½Ð°ÝEXCEL VBA¬O§_¦³¿ìªk°µ¨ì¤Q¤j¶µ¥Øªº²Ó¶µ¥\¯à...?

Haven

¦U¦ì¤j¤j¦n¡A¥ý¬°¥»¤Hªºªí¹F¯à¤O¤£¨¬¹Dºp...
¤p¾|¤u§@¤W»Ý¨D¡A»Ý­n±N¨C¤éªº²§±`¬ö¿ý¡õ

¤U¸ü (64.89 KB)

2016-3-23 02:29

¾ã²z¦¨¥H¤Uªí®æªº®æ¦¡¡õ

¤U¸ü (48.63 KB)

2016-3-23 02:28

·Q½Ð°Ý¬O§_¦³¿ìªk¥i±N¼Ï¯Ã¤ÀªRªíÂà´«¦¨¡u¾î¦¡¡v
(¡õ§â¼Ï¯Ã¦Û°ÊÅܦ¨)

¤U¸ü (52.78 KB)
¼Ï¯Ã

2016-3-23 02:30

(¡õÅܦ¨³oºØ¾î¦¡)

¤U¸ü (58.67 KB)

2016-3-23 02:28

©Î¬OVBA¦³¿ìªk¦Û°Ê§ì¨ú©T©w¦ì¸mªº¼Æ¾Ú¨Ó¿z¿ï
ÁÙ¬O¦³¨ä¥L¤è¦¡¥i¥H¹F¦¨°ÆÀɪº¥Ø¼Ðªí®æ...
·PÁ¦U¦ìªº±Ð¾É!

ªþÀÉ¡G
EXCEL VBA µo°Ý.zip (21.58 KB)

NG«~¶µ¤Q¤j¾÷¥x
¤U¸ü¦¸¼Æ: 15

2016-3-23 02:15

stillfish00

¦^´_ 1# Haven

1. Sub Test()
   
2.     Dim ar, dMachines As Object, dTemp As Object
   
3.     ar = [a1].CurrentRegion.Value
   
4.     Set dMachines = CreateObject("scripting.dictionary")
   
5.     For i = 2 To UBound(ar)
   
6.         If Not dMachines.exists(ar(i, 2)) Then
   
7.             Set dTemp = CreateObject("scripting.dictionary")
   
8.             dMachines.Add ar(i, 2), dTemp
   
9.         Else
   
10.             Set dTemp = dMachines(ar(i, 2))
    
11.         End If
    
12.         dTemp(ar(i, 1)) = dTemp(ar(i, 1)) + 1
    
13.     Next
    
14.    
    
15.     For Each x In dMachines.keys
    
16.         s = ""
    
17.         Set dTemp = dMachines(x)
    
18.         For Each y In dTemp.keys
    
19.             s = s & IIf(Len(s) = 0, "", ",") & y & "*" & dTemp(y)
    
20.         Next
    
21.         dMachines(x) = s
    
22.     Next
    
23.    
    
24.     'Output
    
25.     With Sheets.Add
    
26.         .[b1].Resize(dMachines.Count) = Application.Transpose(dMachines.keys)
    
27.         .[c1].Resize(dMachines.Count) = Application.Transpose(dMachines.items)
    
28.         .[b1].Resize(dMachines.Count, 2).Sort .[b1]
    
29.         .[a1].Value = Format(Now(), "m¤ëd¤é")
    
30.         .[a1].Resize(dMachines.Count).Merge
    
31.     End With
    
32. End Sub

½Æ»s¥N½X

Haven

¤£¦n·N«ä¡Aªí¹F¯à¤O¯uªº¤ñ¸û®t...¨ä¹ê¤ñ¸û·Q°Ýªº¬O«ç»ò§â¸ê®Æ¥ý¤À¦¨«e¤Q¤j°ÝÃD³]³Æ¡A¦A°w¹ï«e¤Q¤j³]³Æªº¯Ê¥¢¶µ¥Ø±Æ¦¨³o¼Ëªº®æ¦¡QQ...

«Ü·PÁ¤j¤jªº±Ð¾Ç~!!!¯uªº·P¿E®÷¹s!!!
¤W­±ªºµ{¦¡±Æªk®Ä²v¯uªº¦n°ª!!

Haven

¦^´_ 2# stillfish00
µo¤å¤T¤ÀÄÁ¸T¤î­×§ïOrz

¤j¤j«D±`©êºp...
ÁÙ¤Ö¤F¤@¶µ±ø¥ó»Ý­n½Õ¾ã...

¤U¸ü (257.01 KB)

2016-3-24 11:54

Åܦ¨³o¼Ë...

¤U¸ü (64.67 KB)

2016-3-24 11:55

«Ü©êºp,³Ìªñ³£¨SºÎ¦n¤Ó°g½k...Orz

«ö·Ó²§±`ÀW²v³Ì°ªªº³]³Æ¨Ì§Ç±Æ¤ñ«á¿ï¥X«e¤Q¤j²§±`³]³Æ...
­«·sªþÀÉ...«D±`©êºpQQ
EXCELµo°Ý.zip (10.98 KB)

¤U¸ü¦¸¼Æ: 10

2016-3-24 11:58

stillfish00

¦^´_ 4# Haven

1. Sub Test()
   
2.     Dim ar, dMachines As Object, dTemp As Object
   
3.     ar = [a1].CurrentRegion.Value
   
4.     Set dMachines = CreateObject("scripting.dictionary")
   
5.     Set dBelong = CreateObject("scripting.dictionary")
   
6.     For i = 2 To UBound(ar)
   
7.         If Not dMachines.exists(ar(i, 3)) Then
   
8.             Set dTemp = CreateObject("scripting.dictionary")
   
9.             dMachines.Add ar(i, 3), dTemp
   
10.         Else
    
11.             Set dTemp = dMachines(ar(i, 3))
    
12.         End If
    
13.         dTemp(ar(i, 2)) = dTemp(ar(i, 2)) + 1
    
14.         dBelong(ar(i, 3)) = ar(i, 1)
    
15.     Next
    
16.    
    
17.     Dim s As String, cnt As Integer
    
18.     For Each x In dMachines.keys
    
19.         s = "": cnt = 0
    
20.         Set dTemp = dMachines(x)
    
21.         For Each y In dTemp.keys
    
22.             s = s & IIf(Len(s) = 0, "", ",") & y & "*" & dTemp(y)
    
23.             cnt = cnt + dTemp(y)
    
24.         Next
    
25.         dMachines(x) = Array(x, s, dBelong(x) & "³]³Æ²§±`", cnt)
    
26.     Next
    
27.    
    
28.     'Output
    
29.     With Sheets.Add
    
30.         cnt = dMachines.Count
    
31.         With .[a1]
    
32.             .Cells(1, 2).Resize(cnt, 4) = Application.Transpose(Application.Transpose(dMachines.items))
    
33.             .Resize(cnt, 5).Sort .Cells(1, 5), xlDescending ', , .Cells(1, 2), xlAscending
    
34.             .Cells(1, 5).EntireColumn.ClearContents
    
35.             If cnt > 10 Then
    
36.                 .Offset(10).Resize(cnt - 10, 4).ClearContents
    
37.                 cnt = 10
    
38.             End If
    
39.             .Value = Format(Now(), "m¤ëd¤é")
    
40.             .Resize(cnt).Merge
    
41.         End With
    
42.     End With
    
43. End Sub

½Æ»s¥N½X

Haven

·PÁ¤j¤j«ü¾É...«e°}¤l¤u§@ªº¦a¤è¨S¿ìªk¤Wºô...
¤@ª½¨S¦^À³«Ü©êºp...ʨ

Haven

¤£¦n·N«ä ¦h¦¸³Â·Ð...·Q¦A¦¸¸ß°Ý...§Ú¥Î¤j¤jªº½s½X°µ¾ã²z
³Ìªñµo²{¡A¦ü¥G¦³¸õ¦W¦¸ªºª¬ªp¥X²{
¤U¹Ï¥ªÃä¬O¤j¤jªº½s½X©Ò±Æ¥Xªº«e¤Q¤jNG³]³Æ¡A¥kÃä¬O¼Ï¯Ã¤ÀªRªí±Æ¥Xªº¤Q¤jNG³]³Æ

¤U¸ü (33.28 KB)
¸õ¦W¦¸

2016-4-12 08:31

³Ì¥kÃ䪺¬O³]³Æªº±Æ¦W...

1. Dim ar, dMachines As Object, dTemp As Object
   
2.     ar = [a1].CurrentRegion.Value
   
3.     Set dMachines = CreateObject("scripting.dictionary")
   
4.     Set dBelong = CreateObject("scripting.dictionary")
   
5.     For i = 2 To UBound(ar)
   
6.         If Not dMachines.exists(ar(i, 3)) Then
   
7.             Set dTemp = CreateObject("scripting.dictionary")
   
8.             dMachines.Add ar(i, 3), dTemp
   
9.         Else
   
10.             Set dTemp = dMachines(ar(i, 3))
    
11.         End If
    
12.         dTemp(ar(i, 2)) = dTemp(ar(i, 2)) + 1
    
13.         dBelong(ar(i, 3)) = ar(i, 1)
    
14.     Next
    
15.    
    
16.     Dim s As String, cnt As Integer
    
17.     For Each x In dMachines.keys
    
18.         s = "": cnt = 0
    
19.         Set dTemp = dMachines(x)
    
20.         For Each y In dTemp.keys
    
21.             s = s & IIf(Len(s) = 0, "", ",") & y & "*" & dTemp(y)
    
22.             cnt = cnt + dTemp(y)
    
23.         Next
    
24.         dMachines(x) = Array(x, s, "·Ð½Ð" & dBelong(x) & "¨ó§U½T»{³]³Æ±¡§Î", cnt)
    
25.     Next
    
26.    
    
27.     'Output
    
28.     With Sheets.Add
    
29.     ActiveSheet.Name = "NG³]³Æ(ªí®æ)"
    
30.         cnt = dMachines.Count
    
31.         With .[a1]
    
32.             .Cells(1, 2).Resize(cnt, 4) = Application.Transpose(Application.Transpose(dMachines.items))
    
33.             .Resize(cnt, 5).Sort .Cells(1, 5), xlDescending ', , .Cells(1, 2), xlAscending
    
34.             .Cells(1, 5).EntireColumn.ClearContents
    
35.             If cnt > 10 Then
    
36.                 .Offset(10).Resize(cnt - 10, 4).ClearContents
    
37.                 cnt = 10
    
38.             End If
    
39.             .Value = Format(Now() - 1, "m¤ëd¤é")
    
40.             .Resize(cnt).Merge
    
41.         End With
    
42.     End With

½Æ»s¥N½X

¥Ø«e¬O¦³¤p§ï½s½X...
½Ð°Ý¤j¤j³o¼Ëªºª¬ªp¸Ó¦p¦ó¸ÑQQ?

PS.©êºp¹ê»Ú³]³Æ¦WºÙ¦]«O±K±ø¬ù±oÁקK¤½¶}...³y¦¨¤£«K«Ü©êºp...

Haven

¤w¸Ñ¨M...·PÁÂQQ

Andy2483

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å¤¤ªº¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
°õ¦æ«e:

¤U¸ü (174.93 KB)

2024-1-12 16:39

°õ¦æµ²ªG:

¤U¸ü (226.38 KB)

2024-1-12 16:39

Option Explicit
Sub TEST()
Dim Brr, Crr, A, Z, B, i&, R&, T$, T1$, T2$, T3$
Application.DisplayAlerts = False
Set Z = CreateObject("Scripting.Dictionary")
Brr = Range([C1], [A65536].End(3))
For i = 2 To UBound(Brr)
   T1 = Brr(i, 1): T2 = Brr(i, 2): T3 = Brr(i, 3)
   If Not IsObject(Z(T3)) Then Set Z(T3) = CreateObject("Scripting.Dictionary"): Z(T3 & "/s") = Brr(i, 1)
   Set A = Z(T3): A(T2) = A(T2) + 1: Set Z(T3) = A: Z(T3 & "/n") = Z(T3 & "/n") + 1
Next
ReDim Crr(1 To 1000, 3)
For Each A In Z.KEYS
   If Not IsObject(Z(A)) Then GoTo A01 Else R = R + 1
   For Each B In Z(A).KEYS: T = T & "," & B & "*" & Z(A)(B): Next
   Crr(R, 0) = Z(A & "/n")
   Crr(R, 1) = A
   Crr(R, 2) = Mid(T, 2): T = ""
   Crr(R, 3) = Z(A & "/s") & "³]³Æ²§±`"
A01: Next
If R = 0 Then Exit Sub Else [E15].Resize(R, 4).Delete
With [E15].Resize(R, 4)
   .Value = Crr
   .Sort KEY1:=.Item(1), Order1:=2, Header:=2
   .Offset(10).Delete
   .Item(1).Resize(10).Merge: .Item(1) = Date
   [E15].Resize(10, 4).Borders.LineStyle = 1
End With
End Sub