- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 276
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2024-12-22
              
|
6#
發表於 2010-8-25 00:46
| 只看該作者
回復 4# hoyeh - Sub 明細()
- Dim Ar As Variant, Ay()
- Set dic = CreateObject("Scripting.Dictionary")
- With Sheet1
- For Each a In .Range(.[D2], .[D65536].End(xlUp))
- If IsEmpty(dic(a.Value)) Then
- Ar = _
- Array(Mid(a.Offset(, -1), 3, 2), Mid(a.Offset(, -1), 5, 2), "", "", "", "", "", a.Offset(, 1).Value, a.Offset(, 2).Value, a.Offset(, 3).Value)
- ReDim Preserve Ay(0): Ay(0) = Ar
- dic(a.Value) = Ay
- Else
- Ay = dic(a.Value)
- s = UBound(Ay) + 1
- ReDim Preserve Ay(s)
- Ay(s) = _
- Array(Mid(a.Offset(, -1), 3, 2), Mid(a.Offset(, -1), 5, 2), "", "", "", "", "", a.Offset(, 1).Value, a.Offset(, 2).Value, a.Offset(, 3).Value)
- dic(a.Value) = Ay
- End If
- Next
- End With
- With Sheet2
- For Each ky In dic.keys
- .[A7:J52] = ""
- .[C3] = ky
- s = UBound(dic(ky)) + 1
- If s > 46 Then
- i = 0
- Do Until i = s
- r = 0: [A7:J52] = ""
- Do Until r = 46 Or i = s
- .[A7].Offset(r, 0).Resize(, 10) = dic(ky)(i)
- r = r + 1
- i = i + 1
- Loop
- .PrintPreview
- Loop
- Else
- .[A7].Resize(s, 10) = Application.Transpose(Application.Transpose(dic(ky)))
- .PrintPreview
- End If
- Next
- End With
- End Sub
- Sub 產銷()
- With Sheet3
- i = 3
- Do Until i = .[B65536].End(xlUp).Row
- r = 0: Sheet4.[A3:J41] = ""
- Do Until r = 39 Or i = .[B65536].End(xlUp).Row
- Sheet4.[A3].Offset(r, 0).Resize(, 10) = _
- Array(.Cells(i, "B"), .Cells(i, "C"), "PCS", "", "", "", .Cells(i, "G"), "KG", .Cells(i, "F") / .Cells(i, "G"), .Cells(i, "F"))
- r = r + 1: i = i + 1
- Loop
- Sheet4.PrintPreview
- Loop
- Sheet4.PrintPreview
- End With
- End Sub
|
|
發表於 2010-8-23 23:45
| 
