- ©«¤l
- 234
- ¥DÃD
- 19
- ºëµØ
- 0
- ¿n¤À
- 276
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows XP
- ³nÅ骩¥»
- office 2003
- ¾\ŪÅv
- 20
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2013-1-7
- ³Ì«áµn¿ý
- 2021-10-7
|
¦^´_ 1# stephenlee
¸Õ¸Õ¬Ý,¼g¤£¦n,¦A¬Ý¦³¨S¦³°ª¤â¥X¤â
¥t¥~050¤£¬O2000¤À©î¶Ü??,¬°¦ó§Aªº½d¨Ò²Ä¤@²Õ2000¤À©î,²Ä¤G²Õ¤SÅܦ¨2100¤À©î(²Ä¤G²ÕÈè¦n¬°2100,©Ò¥H½d¨Ò¨S¤À©î)
Sub ex()
Dim X%, Y%, K%, Z%, Count%, Check$, a As Object, d As Object
Set d = CreateObject("Scripting.Dictionary")
Sheets("ªþªí1").UsedRange.ClearContents
Sheets("ªþªí1").[a1:L1] = Array("Line", "RP", "CP", "job 1", "job 2", "job 3", "item", " ", "f", "t", "QTY", "group")
For Each a In Sheets("n³B²zªº¸ê®Æ").Range([L2], [L2].End(4))
d(a.Value) = a.Offset(, 1)
Next
For Each a In Sheets("n³B²zªº¸ê®Æ").Range([D2], [D65535].End(3))
If Check = "" Then
Check = a.Value
ElseIf Check <> a.Value Then
Z = 4 - (Count Mod 4)
Count = 0
Check = a.Value
End If
If d.exists(a.Value) Then
With Sheets("ªþªí1")
K = 1: X = 0
If a.Offset(, 1) > d(a.Value) Then
For Y = 1 To WorksheetFunction.Quotient(a.Offset(, 1), d(a.Value))
a.Offset(, -3).Resize(, 3).Copy .[a65535].End(3).Offset(1 + Z).Resize(, 3)
.[g65535].End(3).Offset(1 + Z).Resize(, 6) = Array(a, a.Offset(, 1), K, X + d(a.Value), d(a.Value), a.Offset(, 5))
K = .[I65535].End(3) + d(a.Value)
X = .[J65535].End(3)
Z = 0
Next
a.Offset(, -3).Resize(, 3).Copy .[a65535].End(3).Offset(1 + Z).Resize(, 3)
.[g65535].End(3).Offset(1 + Z).Resize(, 6) = Array(a, a.Offset(, 1), d(a.Value) + .[I65535].End(3), a.Offset(, 1), a.Offset(, 1) Mod d(a.Value), a.Offset(, 5))
Count = Y + Count
Else
a.Offset(, -3).Resize(, 3).Copy .[a65535].End(3).Offset(1 + Z).Resize(, 3)
.[g65535].End(3).Offset(1 + Z).Resize(, 6) = Array(a, a.Offset(, 1), 1, a.Offset(, 1), a.Offset(, 1), a.Offset(, 5))
Count = Count + 1
Z = 0
End If
End With
End If
Next
Set d = Nothing
End Sub |
|