¡m½Ð±Ð¡nvba ¦X¨ÖÀx¦s®æ

eric093

½Ð±Ð¦U¦ì¤j®v­Ì¦³Ãövbaªº¦X¨ÖÀx¦s®æ¡A¦p¬Û¦P¸ê®Æ«h¦X¨Ö¡A¦p¤U¤è¡A§Ú°õ¦æ¤£¹ï¡A½Ð¤j®a«üÂI¤@¤U


¦a°Ï
·s¦Ë
·s¦Ë
®ç¶é
®ç¶é
®ç¶é
®ç¶é
¥x¥_
¥x¥_
¥x¥_
¥x¥_
Sub bb()
Dim xRng, xRng1 As Range
Application.DisplayAlerts = False

k = Range("a65536").End(xlUp).Row

For j =2 to k  
Set xRng = Cells(j, 1)
Set xRng1 = Cells(j - 1, 1)
If xRng1 = xRng Then
     
   Range(xRng, xRng1).Merge
   
End If

Next



End Sub

GBKEE

¦^´_ 1# eric093

¸Õ¸Õ¬Ý

1. Sub bb()
   
2.     Dim xRng(1 To 2) As Range, J As Integer
   
3.     Application.DisplayAlerts = False
   
4.     Set xRng(1) = Range("A2")
   
5.     J = 1
   
6.     Do While xRng(1) <> ""
   
7.         If xRng(1).Offset(J) = xRng(1) Then
   
8.             Set xRng(2) = Union(IIf(xRng(2) Is Nothing, xRng(1), xRng(2)), xRng(1).Offset(J))
   
9.             J = J + 1
   
10.         Else
    
11.             Set xRng(1) = xRng(1).Offset(J)
    
12.             J = 1
    
13.             xRng(2).Merge
    
14.             Set xRng(2) = Nothing
    
15.         End If
    
16.     Loop
    
17. End Sub

½Æ»s¥N½X

eric093

¦^´_ 2# GBKEE


    ·PÁÂÅo¡I
¡@¬O§Ú·Qªº¤Ó²³æÅo¡C

rouber590324

dear all ¤j¤j
1.°õ¦æ«áÀx¦s®æA2-A15¤Í°õ¦æ¬Û¦P¤º®e¦X¨Ö.µM«á°±©ó xRng(2).Merge ¨q¥X ¨S¦³³]©wª«¥óÅܼƩÎwith¶ôÅܼÆ
2.why?? ·Ð¤£§[½ç±Ð. thanks   

Sub bb()

    Dim xRng(1 To 2) As Range, J As Integer

    Application.DisplayAlerts = False

    Set xRng(1) = Range("A2")

    J = 1

    Do While xRng(1) <> ""

        If xRng(1).Offset(J) = xRng(1) Then

            Set xRng(2) = Union(IIf(xRng(2) Is Nothing, xRng(1), xRng(2)), xRng(1).Offset(J))

            J = J + 1

        Else

            Set xRng(1) = xRng(1).Offset(J)

            J = 1

            xRng(2).Merge

            Set xRng(2) = Nothing

        End If

    Loop

End Sub

Kubi

¦^´_ 1# eric093

1. Sub bb()
   
2.     k = Range("A65536").End(xlUp).Row
   
3.     Application.DisplayAlerts = False
   
4.     For j = 1 To k
   
5.         If Cells(j, 1).Value <> A Then
   
6.             A = Cells(j, 1).Value
   
7.             d = Cells(j, 1).Address
   
8.         Else
   
9.             Range(d & ":" & Cells(j, 1).Address).Merge
   
10.         End If
    
11.     Next
    
12.     Application.DisplayAlerts = True
    
13. End Sub

½Æ»s¥N½X

rouber590324

DEAR Kubi ¤j¤j
·PÁ±z¤§¸Ñ´b  THANKS*10000

­ã´£³¡ªL

Sub TEST()
Dim xR As Range, xH As Range
Application.DisplayAlerts = False
For Each xR In Range([A2], [A65536].End(xlUp))
    If xR <> xR(0) Then Set xH = xR
    If xR <> xR(2) Then Range(xR, xH).Merge
Next
End Sub

rouber590324

DEAR  ­ã´£³¡ªL ¤j¤j
1.100%²Å¦X»Ý¨D ·PÁ±z¤§¸Ñ´b  THANKS*10000