- 帖子
- 835
- 主題
- 6
- 精華
- 0
- 積分
- 915
- 點名
- 16
- 作業系統
- Win 10,7
- 軟體版本
- 2019,2013,2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2010-5-3
- 最後登錄
- 2024-11-14
|
2#
發表於 2024-10-16 02:49
| 只看該作者
我放在 Open 裡, 你再自己改放到你要的 Sub 裡 :- Dim lRow&, lRows&
- Dim sStr$
- Dim dTar
- Dim wsTar As Worksheet
-
- Set dTar = CreateObject("Scripting.Dictionary") ' 搜尋關鍵字
-
- For Each wsTar In Worksheets ' 遍歷所有工作表
- sStr = wsTar.Name ' 工作表名稱
- If Left(sStr, 1) = "T" Then
- Worksheets(sStr).Cells.ClearContents ' 清除 "T" 開頭的工作表內容
- dTar(sStr) = sStr ' 紀錄 "T" 開頭的工作表名稱,避免發生找不到工作表的錯誤
- End If
- Next
-
- With Worksheets("AA")
- lRows = .Cells(Rows.Count, 1).End(xlUp).Row ' 找最末列
- lRow = 1
-
- Do While lRow <= lRows
- sStr = "T" & .Cells(lRow, 1) ' 工作表名稱
- If dTar(sStr) <> "" Then ' 找到對應工作表
- .Cells(lRow, 1).CurrentRegion.Copy ' 區塊複製
- Worksheets(sStr).[A2].PasteSpecial Paste:=xlPasteValues ' 在對應工作表的 A2 貼上值
- lRow = lRow + .Cells(lRow, 1).CurrentRegion.Rows.Count - 1 ' 跳過已處理的區塊
- End If
- lRow = lRow + 1
- Loop
- End With
 1015_ans.zip (22 Bytes)
|
|
