- 帖子
- 234
- 主題
- 19
- 精華
- 0
- 積分
- 276
- 點名
- 0
- 作業系統
- Windows XP
- 軟體版本
- office 2003
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2013-1-7
- 最後登錄
- 2021-10-7
|
回復 5# Hsieh
驗證後已解決相同Item只能抓到一筆的問題
參考版主的程式,將For..Next改用Do while..loop也能得到一樣的效果
感謝版主的指導
Sub ex()
Dim Rng As Range, a, b As Range, c As Range
With Sheet2
r = 2
Do Until .Cells(r, 1) = ""
a = .Cells(r, 1)
Set b = Sheet1.Range("A2")
With Sheet1
Set c = Nothing
Do While b <> ""
If b = a Then
If c Is Nothing Then
Set c = b.MergeArea.Resize(, 6)
Else
Set c = Union(c, b.MergeArea.Resize(, 6))
End If
End If
Set b = b.Offset(1)
Loop
If Not c Is Nothing Then
If Rng Is Nothing Then
Set Rng = c
Else
Set Rng = Union(Rng, c)
End If
End If
End With
r = r + 1
Loop
End With
With Sheet3
.UsedRange.Offset(1).Clear
Rng.Copy .[A2]
End With
End Sub |
|
發表於 2013-2-4 10:50
| 
