- ©«¤l
- 234
- ¥DÃD
- 19
- ºëµØ
- 0
- ¿n¤À
- 276
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows XP
- ³nÅ骩¥»
- office 2003
- ¾\ŪÅv
- 20
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2013-1-7
- ³Ì«áµn¿ý
- 2021-10-7
|
¦^´_ 5# Hsieh
ÅçÃÒ«á¤w¸Ñ¨M¬Û¦PItem¥u¯à§ì¨ì¤@µ§ªº°ÝÃD
°Ñ¦Òª©¥Dªºµ{¦¡,±NFor..Next§ï¥ÎDo while..loop¤]¯à±o¨ì¤@¼Ëªº®ÄªG
·PÁª©¥Dªº«ü¾É
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 |
|