- ©«¤l
- 967
- ¥DÃD
- 0
- ºëµØ
- 0
- ¿n¤À
- 1001
- ÂI¦W
- 0
- §@·~¨t²Î
- WIN XP
- ³nÅ骩¥»
- OFFICE 2003
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥x¥_
- µù¥U®É¶¡
- 2010-11-29
- ³Ì«áµn¿ý
- 2022-5-17
|
¥»©«³Ì«á¥Ñ register313 ©ó 2012-5-1 13:03 ½s¿è
¦^´_ 1# white5168
°Ñ¦Ò¥Î,»yªk¤£²z·Q,°õ¦æ³t«×ºC
¦Û°Êµ²ºâ¨ìÁʶR¤é´Á¤§³Ì«á¤@¤é
SOURCE¤u§@ªí·|³Q±Æ§Ç- Sub AA()
- Dim Er(), Fr()
- Set d = CreateObject("scripting.dictionary")
- Set d1 = CreateObject("scripting.dictionary")
- Set d2 = CreateObject("scripting.dictionary")
- Set d3 = CreateObject("scripting.dictionary")
- With Sheets("Source")
- M = .[B2].End(xlDown).Row
- .[A1].CurrentRegion.Sort Key1:=.[A2], Order1:=xlAscending, Header:=xlGuess
- .[A1].CurrentRegion.Sort Key1:=.[B2], Order1:=xlAscending, Header:=xlGuess
- Br = .Range("A2:E" & .[B2].End(xlDown).Row)
- For i = 1 To UBound(Br)
- x = Br(i, 2)
- d(x) = d(x) + 1
- If Not d1.exists(x) Then d1.Add x, Br(i, 4) Else d1(x) = d1(x) + Br(i, 4)
- If Not d2.exists(x) Then d2.Add x, Br(i, 5) Else d2(x) = d2(x) + Br(i, 5)
- If Not d3.exists(x) Then d3.Add x, Br(i, 3) * (Br(i, 5) - Br(i, 4)) Else d3(x) = d3(x) + Br(i, 3) * (Br(i, 5) - Br(i, 4))
- Next i
- End With
- With Sheets("³Ì«á¸ê®Æ")
- .[B1] = Application.Max(Sheets("Source").Columns("A"))
- .[A3].CurrentRegion.Offset(1, 0) = ""
- .[A4].Resize(d.Count, 1) = Application.Transpose(d.keys)
- .[B4].Resize(d.Count, 1) = Application.Transpose(d1.Items)
- .[C4].Resize(d.Count, 1) = Application.Transpose(d2.Items)
- .[D4].Resize(d.Count, 1) = Application.Transpose(d3.Items)
- For R = 4 To d.Count + 3
- ReDim Preserve Er(4 To R)
- ReDim Preserve Fr(4 To R)
- If .Cells(R, "B") >= .Cells(R, "C") Then
- Er(R) = .Cells(R, "B") - .Cells(R, "C")
- Else
- Fr(R) = .Cells(R, "B") - .Cells(R, "C")
- End If
- Next R
- .[E4].Resize(R - 4, 1) = Application.Transpose(Er)
- .[F4].Resize(R - 4, 1) = Application.Transpose(Fr)
- For R = 4 To d.Count + 3
- If .Cells(R, "E") > 0 Then
- Max = Application.Match(.Cells(R, "A"), Sheets("Source").Range(Sheets("Source").[B1], Sheets("Source").[B1].End(xlDown)), 0) + d(.Cells(R, "A").Value) - 1
- Min = Max - d(.Cells(R, "A").Value) + 1
- Á`ÃB = 0: ³Ñ¾lÁ`¼Æ = 0
- ³Ñ¾l¼Æ¶q = .Cells(R, "E")
- For S = Max To Min Step -1
- If ³Ñ¾l¼Æ¶q > Sheets("Source").Cells(S, "D") Then
- Á`ÃB = Á`ÃB + Sheets("Source").Cells(S, "C") * Sheets("Source").Cells(S, "D")
- ³Ñ¾l¼Æ¶q = ³Ñ¾l¼Æ¶q - Sheets("Source").Cells(S, "D")
- ³Ñ¾lÁ`¼Æ1 = ³Ñ¾lÁ`¼Æ1 + Sheets("Source").Cells(S, "D")
- Else
- Á`ÃB = Á`ÃB + Sheets("Source").Cells(S, "C") * ³Ñ¾l¼Æ¶q
- .Cells(R, "G") = Á`ÃB / .Cells(R, "E")
- .Cells(R, "D") = .Cells(R, "D") + Á`ÃB * 2
- GoTo 123
- End If
- Next S
- End If
- 123:
- Next R
- For R = 4 To d.Count + 3
- If .Cells(R, "F") < 0 Then
- Max = Application.Match(.Cells(R, "A"), Sheets("Source").Range(Sheets("Source").[B1], Sheets("Source").[B1].End(xlDown)), 0) + d(.Cells(R, "A").Value) - 1
- Min = Max - d(.Cells(R, "A").Value) + 1
- Á`ÃB = 0: ³Ñ¾lÁ`¼Æ = 0
- ³Ñ¾l¼Æ¶q = -.Cells(R, "F")
- For S = Max To Min Step -1
- If ³Ñ¾l¼Æ¶q > Sheets("Source").Cells(S, "E") Then
- Á`ÃB = Á`ÃB + Sheets("Source").Cells(S, "C") * Sheets("Source").Cells(S, "E")
- ³Ñ¾l¼Æ¶q = ³Ñ¾l¼Æ¶q - Sheets("Source").Cells(S, "E")
- ³Ñ¾lÁ`¼Æ1 = ³Ñ¾lÁ`¼Æ1 + Sheets("Source").Cells(S, "E")
- Else
- Á`ÃB = Á`ÃB + Sheets("Source").Cells(S, "C") * ³Ñ¾l¼Æ¶q
- .Cells(R, "H") = Á`ÃB / -.Cells(R, "F")
- GoTo 456
- End If
- Next S
- End If
- 456:
- Next R
- .Range("G4:H" & d.Count + 3).NumberFormatLocal = "0.00"
- End With
- MsgBox "µ²ºâ§¹²¦"
- End Sub
½Æ»s¥N½X
test.rar (14.91 KB)
|
|