- ©«¤l
- 5923
- ¥DÃD
- 13
- ºëµØ
- 1
- ¿n¤À
- 5986
- ÂI¦W
- 0
- §@·~¨t²Î
- win10
- ³nÅ骩¥»
- Office 2010
- ¾\ŪÅv
- 150
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW°ò¶©
- µù¥U®É¶¡
- 2010-5-1
- ³Ì«áµn¿ý
- 2022-1-23
|
¦^´_ 3# united7878
¸Õ¸Õ¬Ý- Option Explicit
- Sub Ex()
- Dim Rng As Range, Quantity(1 To 2) As Integer, Total(1 To 2) As Double
- Dim Sh As Worksheet, i(1 To 2) As Integer
- Set Rng = Sheets("C").[B2]
- Set Sh = Sheets.Add '·s¼W¤u§@ªí
- Do While Rng <> ""
- With Sheets("A")
- .Range("a1").AutoFilter Field:=2, Criteria1:=Rng
- Quantity(1) = Application.Sum(.Range("d:d").SpecialCells(xlCellTypeVisible))
- Total(1) = Application.Sum(.Range("E:E").SpecialCells(xlCellTypeVisible))
- End With
- With Sheets("B")
- .Range("a1").AutoFilter Field:=2, Criteria1:=Rng
- Quantity(2) = Application.Sum(.Range("d:d").SpecialCells(xlCellTypeVisible))
- Total(2) = Application.Sum(.Range("E:E").SpecialCells(xlCellTypeVisible))
- End With
- With Rng
- .Cells(1, 2) = Quantity(1) - Quantity(2) '®w¦s¼Æ¶q
- If .Cells(1, 2) > 0 Then '¦³®w¦s¼Æ¶q
- If Total(2) > 0 Then '¾P³f¼Æ¶q
- Total(2) = 0
- i(1) = .Cells(1, 2)
- With Sh
- .UsedRange.Clear
- Sheets("A").UsedRange.Copy .[A1] '½Æ»s: Aªí¦Û°Ê¿z¿ï«áªº¼ÆÈ
- i(2) = .UsedRange.Rows.Count '¸ê®Æªº³Ì«á¤@¦C
- Do While i(1) > 0 '®w¦s¼Æ¤j©ó 0
- Do While .Cells(i(2), "D") > 0 And i(1) > 0
- Total(2) = Total(2) + .Cells(i(2), "c")
- i(1) = i(1) - 1 '®w¦s¼Æ - 1
- .Cells(i(2), "D") = .Cells(i(2), "D") - 1 '¶i³f¼Æ¶q -1
- Loop
- i(2) = i(2) - 1 '¸ê®Æ¦C ¤W²¾ ¤@¦C
- Loop
- End With
- .Cells(1, 3) = Round(Total(2) / .Cells(1, 2), 1)
- Else ' ¾P³f¼Æ¶q¬°0
- .Cells(1, 3) = Round((Total(1) - Total(2)) / .Cells(1, 2), 1)
- End If
- Else '¨S¦³®w¦s¼Æ¶q
- .Cells(1, 3) = 0
- End If
- End With
- Set Rng = Rng.Offset(1)
- Loop
- Application.DisplayAlerts = False
- Sh.Delete '§R°£:·s¼Wªº¤u§@ªí
- Application.DisplayAlerts = True
- End Sub
½Æ»s¥N½X |
|