b9208

¦^´_ 6# Hsieh
Dear Hsieh
«D±`·PÁÂÀ°¦£»P«ü¾É
¥Ø«e¹B¦æ¤W¬Ookªº
ÁÂÁÂ

b9208

¦^´_ 7# ML089
Dear ML089

ÁÂÁ°ѻP«ü¾É»P°Q½×¡A¥i¥H¾Ç²ß¨Ï¥Î¨ç¼Æ²Õ¦X¹B¥Î¡C
¶Wª©ªºvba¥i¥H²Î­pµ§¼Æ¤Î¼Æ¶q¡C

b9208

¦^´_ 6# Hsieh
Dear Hsieh

For Each a In Range([B8], [B8].End(xlDown))
m = a.Text & "," & a.Offset(, 2) & "," & a.Offset(, 4)
n = a.Text & "," & a.Offset(, 1) & "," & a.Offset(, 2)
   If d(m) <= a.Offset(, 7) Then d(m) = a.Offset(, 7)
   d1(n) = ""
Next
  
¤W¥y¤¤ d1(n) = ""   ¤§¥Î·N¬°¦ó¡H
·PÁ«ü¾É

b9208

¦^´_ 6# Hsieh
Dear Hsieh
µ{¦¡¤Î¿é¥X¸ê®Æ¦b¦P¤@¤u§@ªí¡A°õ¦æOK¡C
¦pªGµ{¦¡¤Î¿é¥Xªí®æ¸m©ósheet2¡A°ò¥»¸ê®Æ¸m©ósheet1¡A¿é¥X¸ê®Æ³£¬O0¡C­×­q¦p¤U¡G
With Sheets("sheet1")
For Each a In Range([B8], [B8].End(xlDown))
..........
.........................
End With
For Each a In [N8:N14]

¥t½Ð±Ð¼W¥[ª½±µ­pºâ¥[Á` Total ¥\¯à¡A¦p¦ó­×§ï¡CÁÂÁÂ

Hsieh

¦^´_ 14# b9208

1. Sub ex()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. Set d1 = CreateObject("Scripting.Dictionary")
   
4. With Sheets("Sheet1")
   
5. For Each a In .Range(.[B8], .[B8].End(xlDown))
   
6. m = a.Text & "," & a.Offset(, 2) & "," & a.Offset(, 4)
   
7. n = a.Text & "," & a.Offset(, 1) & "," & a.Offset(, 2)
   
8.    If d(m) <= a.Offset(, 7) Then _
   
9.    d(m) = a.Offset(, 7) '¨ú¥XB¡BD¡BFÄæ¦P²Õ³Ì¤j­È
   
10.    d1(n) = "" 'B¡BC¡BDÄ椣­«½Æ¯Á¤Þ
    
11. Next
    
12. End With
    
13. For Each ky In d.keys
    
14.   ar = Split(ky, ",")
    
15.   d(ar(0) & ar(1)) = d(ar(0) & ar(1)) + d(ky) '¨ú¥XB¡BD¡BFÄæ¦P²Õ¥[Á`
    
16. Next
    
17. For Each ky In d1.keys
    
18.   ar = Split(ky, ",")
    
19.   d1(ar(0) & ar(2)) = d1(ar(0) & ar(2)) + 1 ''B¡BC¡BDÄæ²Õ¦X­p¼Æ
    
20. Next
    
21. With Sheets("Sheet2")
    
22. For Each c In .[O7:P7]
    
23. cnt = 0
    
24.    For Each a In .[N8:N14]
    
25.     .Cells(a.Row, c.Column) = IIf(d1(a & c) = "", 0, d1(a & c))  '¨Ì§Ç¶ñ¤J²Õ¦X­p¼Æ
    
26.      cnt = cnt + d1(a & c)
    
27.    Next
    
28. .Cells(15, c.Column) = cnt
    
29. Next
    
30. For Each c In .[O7:P7]
    
31. cnt = 0
    
32.     For Each a In .[N19:N25]
    
33.      .Cells(a.Row, c.Column) = IIf(d(a & c) = "", 0, d(a & c)) '¨Ì§Ç¶ñ¤J²Õ¦X¥[Á`
    
34.      cnt = cnt + d1(a & c)
    
35.    Next
    
36. .Cells(26, c.Column) = cnt
    
37. Next
    
38. End With
    
39. End Sub

½Æ»s¥N½X

T1.rar (13.39 KB)

¤U¸ü¦¸¼Æ: 17

2013-4-27 23:20

b9208

¦^´_ 15# Hsieh
ÁÂÁª©¥D
¥i¥H°õ¦æ
²Å¦X»Ý¨D

freeffly

¦^´_ 15# Hsieh


    ¤@¦æ¤@¦æ¬Ý¯à¤j²¤¯à¸ÑŪ
   ¤£¹L­n¦Û¤v¼g¥X¨Ó¦³ÂIÃø
   ¾Ç²ß¤F

b9208

¦^´_ 15# Hsieh
Dear Hsieh

For Each a In .Range(.[B8], .[B8].End(xlDown))
m = a.Text & "," & a.Offset(, 2) & "," & a.Offset(, 4)
n = a.Text & "," & a.Offset(, 1) & "," & a.Offset(, 2)
   If d(m) <= a.Offset(, 7) Then _
   d(m) = a.Offset(, 7) '¨ú¥XB¡BD¡BFÄæ¦P²Õ³Ì¤j­È
   d1(n) = "" 'B¡BC¡BDÄ椣­«½Æ¯Á¤Þ
Next
¤W­zµ{¦¡¤¤   d1(n) = "" 'B¡BC¡BDÄ椣­«½Æ¯Á¤Þ
«ä¦Ò«Ü¤[¤FÁÙ¬OµLªk²z¸Ñ
d1(n) ³]©w¦¨""¡A«áÄò¦p¦ó­p¼Æ¡H
Àµ½Ð«ü¾É

Hsieh

¦^´_ 18# b9208
¦b¦¹¶¥¬qªº¦r¨å§@¥Î¡A¥D­n¬O¨ú±o¶µ¥Ø
¥ýª¾¹D¦P²Õªº¯Á¤Þ¦³­þ¨Ç?
«á­±
For Each ky In d1.keys
  ar = Split(ky, ",")
  d1(ar(0) & ar(2)) = d1(ar(0) & ar(2)) + 1 ''B¡BC¡BDÄæ²Õ¦X­p¼Æ
Next
³o¬q´N¬OÅýB¡BDÄæ¬Û¦PªÌ­p¼Æ

Andy2483

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

¤U¸ü (163.45 KB)

2024-1-24 08:53

°õ¦æµ²ªG:

¤U¸ü (178.05 KB)

2024-1-24 08:54

Option Explicit
Sub TEST()
Dim Arr, Brr, Crr(8, 100), A%, Z, B%, V%, i&, C%, T2$, T3$, T4$, T6$, T9$
ActiveSheet.UsedRange.EntireColumn.Offset(, 17).Delete
Set Z = CreateObject("Scripting.Dictionary")
Brr = Range([I7], [A65536].End(3))
Crr(0, 0) = Brr(1, 2) & " \ " & Brr(1, 4)
For i = 2 To 8: Crr(i - 1, 0) = Format(i, "DDD"): Z(Crr(i - 1, 0)) = i - 1: Next
Crr(8, 0) = "TOTAL": Arr = Crr
For i = 2 To UBound(Brr)
   T2 = Format(Brr(i, 1), "DDD"): T4 = Brr(i, 4): T6 = Brr(i, 6): T3 = Brr(i, 3): T9 = Brr(i, 9)
   A = Z(T2): B = Z(T4): V = Z(T2 & T6 & T4)
   If B = 0 Then C = C + 1: B = C: Z(Brr(i, 4)) = B: Arr(0, C) = Brr(i, 4): Crr(0, C) = Brr(i, 4)
   If Z(T2 & T3 & T4) = 0 Then Z(T2 & T3 & T4) = 1: Crr(A, B) = Crr(A, B) + 1
   If V = 0 Then V = Val(T9): Z(T2 & T6 & T4) = V: Arr(A, B) = Arr(A, B) + V: GoTo i01
   If Z(T2 & T6 & T4) < Val(T9) Then
      Arr(A, B) = Arr(A, B) - Z(T2 & T6 & T4) + Val(T9): Z(T2 & T6 & T4) = Val(T9)
   End If
i01: Next
[R6] = "²Î­p²Õ§Oµ§¼Æ"
With [R7].Resize(9, C + 1)
   .Value = Crr: .SpecialCells(4) = 0: .Borders.LineStyle = 1: .EntireColumn.HorizontalAlignment = xlCenter
   .Offset(, 1).Sort KEY1:=.Item(1), Order1:=1, Header:=1, Orientation:=2
   .Item(9, 2).Resize(, C) = "=SUM(" & Intersect(.Columns(2), [8:14]).Address(0, 0) & ")"
End With
[R17] = "­pºâ¼Æ¶q"
With [R18].Resize(9, C + 1)
   .Value = Arr: .SpecialCells(4) = 0: .Borders.LineStyle = 1: .Columns(1).EntireColumn.AutoFit
   .Offset(, 1).Sort KEY1:=.Item(1), Order1:=1, Header:=1, Orientation:=2
   .Item(9, 2).Resize(, C) = "=SUM(" & Intersect(.Columns(2), [19:25]).Address(0, 0) & ")"
End With
End Sub