- 帖子
- 46
- 主題
- 3
- 精華
- 0
- 積分
- 73
- 點名
- 0
- 作業系統
- WIN7
- 軟體版本
- Office 2007
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2018-2-12
- 最後登錄
- 2025-9-17
|
回復 6# VANESSA
Sub 載入()
Dim xR As Range, xH As Range, T$
[工作表2!A1:L3000].ClearContents
[工作表1!A1].Resize(1, 5).Copy [工作表2!A1:E1] ''<---新增這一段
Set xH = [工作表2!A2]
Application.ScreenUpdating = False
For Each xR In Range([工作表1!A1], [工作表1!A65536].End(xlUp))
If xR <> "M" Then GoTo 101
If xR(1, 2) <> T Then
xR.Resize(1, 12).Copy xH
Set xH = xH(2): T = xR(1, 2)
End If
xR(1, 16).Resize(1, 6).Copy xH
Set xH = xH(2)
101: Next
End Sub |
|
發表於 2025-9-17 09:18
| 