Board logo

標題: 如何讓相同內容的表格合併 [打印本頁]
作者: deyan    時間: 2010-12-30 23:54     標題: 如何讓相同內容的表格合併

請問按欄位排序後有相同內容的儲存格要合併成1個，
手動的做法是將重複的刪除再選取合併，用程式該怎麼做呢？
作者: 我是誰    時間: 2010-12-31 02:23

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

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

不知道有沒有幫到你~~^^
作者: 317    時間: 2010-12-31 07:34

不妨自己試做一個, 用錄制巨集便可, 還可以從錄制程式中了解運行..
作者: deyan    時間: 2010-12-31 23:26

本帖最後由 deyan 於 2011-1-2 14:59 編輯

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

[attach]4288[/attach]
作者: FAlonso    時間: 2011-1-1 22:33

本帖最後由 FAlonso 於 2011-1-1 22:38 編輯
  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    時間: 2011-1-2 02:34

本帖最後由 deyan 於 2011-1-2 02:38 編輯
大概是這樣,a和b有數字,檢查後merge,試試
FAlonso 發表於 2011-1-1 22:33


已經試過了，

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

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

我再試試看能否修改成自己要的結果，感謝！
作者: FAlonso    時間: 2011-1-2 15:22

已經試過了，

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

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

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


或者上傳檔案來,讓大家參考參考
作者: 317    時間: 2011-1-2 15:55

回復 6# deyan

試試

[attach]4289[/attach]
作者: deyan    時間: 2011-1-3 10:33

謝謝317，但是還不能下載，可以貼代碼或寄給我嗎？
作者: basarasy    時間: 2011-1-3 11:17

本帖最後由 basarasy 於 2011-1-3 11:20 編輯

回復 9# deyan

試試這個.
  1. Sub Macro1()

  3.   Dim MYT1, MYT2, MYT3, MYROW As Integer
  4.   
  5.    Application.DisplayAlerts = False
  6.    
  7.    MYROW = Cells([B:B].Find("*", , , , , 2).Row, 1).Row

  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
複製代碼
作者: GBKEE    時間: 2011-1-3 12:25

回復 9# deyan
這是317的程式碼我代貼上,寫的很好.
  1. Sub nn()
  2. Dim A As Range, r&
  3. Application.DisplayAlerts = False
  4. r = 3
  5. Do While Cells(r, 2) <> ""
  6.    Set A = Cells(r, 2)
  7.    Do Until Cells(r, 2) <> A
  8.    r = r + 1
  9.    Loop
  10.    Range(A, Cells(r - 1, 2)).Merge
  11. Loop
  12. Application.DisplayAlerts = True
  13. End Sub
複製代碼
作者: deyan    時間: 2011-1-3 15:23

謝謝！方法跟我想的很像，只是我寫不出來

請問 MYROW = Cells([B:B].Find("*", , , , , 2).Row, 1).Row

這行中.Find("*", , , , , 2) 代表什麼意思？
作者: freeffly    時間: 2014-10-2 11:39

挺容易理解的代碼
學習了



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)