- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 104
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2025-4-30
               
|
2#
發表於 2011-6-6 14:20
| 只看該作者
回復 1# jesscc - Sub ContainerDetails()
- Set swb = ThisWorkbook
- mypath = "C:\Documents and Settings\Administrator\桌面\"
- myfile = Format(Date, "emmdd") & "已出貨.xlsx"
- swb.Sheets(Array("AA", "BB", "CC")).Copy
- Set wb = ActiveWorkbook
- wb.Sheets("AA").Shapes.Range(Array("CommandButton6")).Delete
- wb.Sheets("AA").Range("B7:J500").ClearContents
- wb.Sheets("BB").Range("B7:J500").ClearContents
- wb.Sheets("CC").Range("B7:J500").ClearContents
-
- For Each Sh In swb.Sheets(Array("AA", "BB", "CC"))
- Dim Ay()
- With Sh
- For i = 7 To .Cells(.Rows.Count, 2).End(xlUp).Row
- If .Range("B" & i) = "v" Or .Range("B" & i) = "*" Then
- ReDim Preserve Ay(s)
- Ay(s) = .Range("B" & i).Resize(, 10).Value
- s = s + 1
- End If
- Next
- wb.Sheets(.Name).[B7].Resize(s, 10) = Application.Transpose(Application.Transpose(Ay))
- Erase Ay
- s = 0
- End With
- Next
- wb.SaveAs mypath & myfile
- End Sub
複製代碼 |
|