[發問] 求助填入專案編號

小弟只會寫簡單的VBA及錄製巨集,所以求助各位先進, 謝謝!

檔案內有2個工作表,生產領退料明細及專案編號, 需將專案編號工作表內的專案編號填入生產領退料明細表內製令單號後面.

樓主熱帖

xandertco

中學生 Rank: 2

帖子: 15
主題: 4
精華: 0
積分: 50
點名: 0
作業系統: WIN7
軟體版本: OFFICE2010
閱讀權限: 20
性別: 男
註冊時間: 2012-8-3
最後登錄: 2013-7-15

2^#

發表於 2013-6-10 08:29 | 只看該作者

本帖最後由 GBKEE 於 2013-6-10 15:05 編輯

加入專案編號.rar (45.8 KB)

專案編號.jpg (467.35 KB)

project.jpg (467.35 KB)

加入專案編號.JPG (260.43 KB)

TOP

stillfish00

大學生 Rank: 4

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

3^#

發表於 2013-6-10 19:53 | 只看該作者

回復 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

複製代碼

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 41
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2025-2-16

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章