- 帖子
- 2842
- 主題
- 10
- 精華
- 0
- 積分
- 2898
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2025-4-28
|
4#
發表於 2020-8-15 10:08
| 只看該作者
表身筆數不定, 用vba吧!
增加一個工作表2:
Sub 載入()
Dim xR As Range, xH As Range, T$
[工作表2!A1:L3000].ClearContents
Set xH = [工作表2!A1]
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
Xl0000322.rar (11.59 KB)
|
|