- 帖子
- 1018
- 主題
- 15
- 精華
- 0
- 積分
- 1058
- 點名
- 0
- 作業系統
- win7 32bit
- 軟體版本
- Office 2016 64-bit
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 桃園
- 註冊時間
- 2012-5-9
- 最後登錄
- 2022-9-28
|
回復 1# xandertco
試試吧- Sub Test()
- Dim r1 As Long, r2 As Long
-
- Application.ScreenUpdating = False
- With Sheets("生產領退料明細表")
- r1 = .Cells(.Rows.Count, "A").End(xlUp).Row - 1 '[合計]的上面一列
-
- ' A9 到 A680 中為常數文字的儲存格
- With .Range(.[A9], .Cells(r1, "A")).SpecialCells(xlCellTypeConstants, xlTextValues)
- For Each x In .Cells
- '對非製令單號的列
- If x.Value <> "製令單號" Then
- With Sheets("專案編號")
- .AutoFilterMode = False '取消自動篩選
- r2 = .Cells(.Rows.Count, "A").End(xlUp).Row '以A欄找最大列數
- .Range("A1:B" & r2).AutoFilter Field:=1, Criteria1:=x.Value '以x單號去篩選
- .Range("B2:B" & r2).SpecialCells(xlCellTypeVisible).Copy '複製B欄可見欄
- End With
- x.Offset(, 16).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, Transpose:=True '轉置貼上到Q欄右方
- End If
- Next
- End With
- End With
-
- Application.ScreenUpdating = True
- End Sub
|
|
發表於 2013-6-10 19:53
| 