- 帖子
- 2839
- 主題
- 10
- 精華
- 0
- 積分
- 2895
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2024-12-22
|
2#
發表於 2019-6-2 11:26
| 只看該作者
Sub TEST()
Dim Sht As Worksheet, UR As Range, xR As Range, i%, c&, r&, N&, ARR
ReDim ARR(1 To 30000, 1 To 6)
Sheets("工作表2").UsedRange.Offset(1, 0).EntireRow.Delete
For Each Sht In Sheets
If Sht.Name Like "#-#" = False Then GoTo 101
Set UR = Sht.UsedRange
For r = 1 To UR.Rows.Count Step 5
For c = 1 To UR.Columns.Count Step 3
Set xR = UR(r + 1, c)
If Application.Sum(xR(2, 3).Resize(3)) = 0 Then GoTo 99
N = N + 1
ARR(N, 1) = "'" & Sht.Name: ARR(N, 2) = xR(2): ARR(N, 3) = xR(0)
For i = 1 To 3
ARR(N, 3 + i) = xR(i + 1, 3)
Next
99: Next c
Next r
101: Next
[工作表2!A2:F2].Resize(N) = ARR
End Sub
 Xl0000341.rar (13.95 KB)
==================== |
|
發表於 2019-6-1 12:35
| 
