如何讓相同內容的表格合併

deyan

請問按欄位排序後有相同內容的儲存格要合併成1個，
手動的做法是將重複的刪除再選取合併，用程式該怎麼做呢？

我是誰

我都是用「工具列」那有一個「跨欄置中」那個選項

符號就是一個「← a →」這個

不知道有沒有幫到你~~^^

317

不妨自己試做一個, 用錄制巨集便可, 還可以從錄制程式中了解運行..

deyan

謝謝樓上2位的回答，我也是用跨欄置中來做，
但是選取資料還是要人判斷，如果資料很多要做很久，
用錄的也沒用，只能記錄動作，無法判斷資料範圍，
想了很久不知道該怎麼寫。

ex.rar (9.93 KB)

說明
下載次數: 12

2011-1-2 14:58

FAlonso

1. Sub abc()
   
2. Dim myrange As Range, mycell As Range, mytarget As Range
   
3. Application.DisplayAlerts = False
   
4. Set myrange = Range("A1:A" & Range("A1").End(xlDown).Row)
   
5. For Each mycell In myrange
   
6. If mycell = mycell.Offset(, 1) Then
   
7. Set mytarget = Union(mycell, mycell.Offset(, 1))
   
8. With mytarget
   
9. .Merge
   
10. .HorizontalAlignment = xlCenter
    
11. End With
    
12. End If
    
13. Next
    
14. Application.DisplayAlerts = True
    
15. End Sub

複製代碼

大概是這樣,a和b有數字,檢查後merge,試試

deyan

大概是這樣,a和b有數字,檢查後merge,試試
FAlonso 發表於 2011-1-1 22:33

已經試過了，

但是我要的結果不是這樣，

要直的、不一定只是2格合併

我再試試看能否修改成自己要的結果，感謝！

FAlonso

已經試過了，

但是我要的結果不是這樣，

要直的、不一定只是2格合併

我再試試看能否修改成自己 ...
deyan 發表於 2011-1-2 02:34

或者上傳檔案來,讓大家參考參考

317

回復 6# deyan

試試

ex2003.rar (9.45 KB)

下載次數: 20

2011-1-2 15:55

deyan

謝謝317，但是還不能下載，可以貼代碼或寄給我嗎？

basarasy

回復 9# deyan

試試這個.

1. Sub Macro1()
   
2. 
   
3.   Dim MYT1, MYT2, MYT3, MYROW As Integer
   
4.   
   
5.    Application.DisplayAlerts = False
   
6.    
   
7.    MYROW = Cells([B:B].Find("*", , , , , 2).Row, 1).Row
   
8. 
   
9.    If MYROW <= 3 Then End
   
10.    
    
11.    MYT1 = 3 'B3開始
    
12.    
    
13.     Do
    
14.         
    
15.     MYT2 = Range("B" & MYT1)
    
16.    
    
17.     MYT3 = MYT1 + 1
    
18.    
    
19.          Do
    
20.         
    
21.               If MYT2 = Range("B" & MYT3) Then
    
22.    
    
23.                  MYT3 = MYT3 + 1
    
24.    
    
25.               Else
    
26.    
    
27.                  Range(Cells(MYT1, 2), Cells(MYT3 - 1, 2)).Merge
    
28.                   MYT2 = 0
    
29.    
    
30.               End If
    
31.                      
    
32.           Loop Until MYT2 = 0
    
33.      
    
34.       MYT1 = MYT3
    
35.       
    
36.    Loop Until MYT1 > MYROW
    
37.      
    
38.     Columns("B:B").HorizontalAlignment = xlCenter
    
39.     Application.DisplayAlerts = True
    
40. End Sub

複製代碼