12
返回列表 上一主題 發帖

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

deyan

帖子
15 
主題
3 
精華
0 
積分
43 
點名
0  
作業系統
Windows 7, XP, OSX 
軟體版本
Office 2010, 2003 
閱讀權限
10 
性別
男 
註冊時間
2010-12-24 
最後登錄
2015-8-7 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2010-12-30 23:54 | 只看該作者

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

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

我是誰

帖子
11 
主題
0 
精華
0 
積分
55 
點名
0  
作業系統
XP 
軟體版本
OFFICE 2000 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2010-11-10 
最後登錄
2011-1-23 
2#
發表於 2010-12-31 02:23 | 只看該作者
我都是用「工具列」那有一個「跨欄置中」那個選項

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

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

TOP

317

帖子
248 
主題
55 
精華
0 
積分
334 
點名
0  
作業系統
xp 
軟體版本
2003 
閱讀權限
20 
註冊時間
2010-7-24 
最後登錄
2023-2-2 
3#
發表於 2010-12-31 07:34 | 只看該作者
不妨自己試做一個, 用錄制巨集便可, 還可以從錄制程式中了解運行..

TOP

deyan

帖子
15 
主題
3 
精華
0 
積分
43 
點名
0  
作業系統
Windows 7, XP, OSX 
軟體版本
Office 2010, 2003 
閱讀權限
10 
性別
男 
註冊時間
2010-12-24 
最後登錄
2015-8-7 
4#
發表於 2010-12-31 23:26 | 只看該作者
[版主管理留言]
  • Hsieh(2011-1-1 01:51): 請附上檔案說明

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

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

ex.rar (9.93 KB)
deyan

TOP

FAlonso

帖子
135 
主題
19 
精華
0 
積分
165 
點名
0  
作業系統
XP 
軟體版本
2003 
閱讀權限
20 
性別
男 
來自
香港 
註冊時間
2010-12-9 
最後登錄
2012-8-27 
5#
發表於 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,試試
80 字節以內
不支持自定義 Discuz! 代碼

TOP

deyan

帖子
15 
主題
3 
精華
0 
積分
43 
點名
0  
作業系統
Windows 7, XP, OSX 
軟體版本
Office 2010, 2003 
閱讀權限
10 
性別
男 
註冊時間
2010-12-24 
最後登錄
2015-8-7 
6#
發表於 2011-1-2 02:34 | 只看該作者
本帖最後由 deyan 於 2011-1-2 02:38 編輯
大概是這樣,a和b有數字,檢查後merge,試試
FAlonso 發表於 2011-1-1 22:33


已經試過了，

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

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

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

TOP

FAlonso

帖子
135 
主題
19 
精華
0 
積分
165 
點名
0  
作業系統
XP 
軟體版本
2003 
閱讀權限
20 
性別
男 
來自
香港 
註冊時間
2010-12-9 
最後登錄
2012-8-27 
7#
發表於 2011-1-2 15:22 | 只看該作者
已經試過了，

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

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

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


或者上傳檔案來,讓大家參考參考
80 字節以內
不支持自定義 Discuz! 代碼

TOP

317

帖子
248 
主題
55 
精華
0 
積分
334 
點名
0  
作業系統
xp 
軟體版本
2003 
閱讀權限
20 
註冊時間
2010-7-24 
最後登錄
2023-2-2 
8#
發表於 2011-1-2 15:55 | 只看該作者
回復 6# deyan

試試

ex2003.rar (9.45 KB)

TOP

deyan

帖子
15 
主題
3 
精華
0 
積分
43 
點名
0  
作業系統
Windows 7, XP, OSX 
軟體版本
Office 2010, 2003 
閱讀權限
10 
性別
男 
註冊時間
2010-12-24 
最後登錄
2015-8-7 
9#
發表於 2011-1-3 10:33 | 只看該作者
謝謝317，但是還不能下載，可以貼代碼或寄給我嗎？
deyan

TOP

basarasy

帖子
287 
主題
65 
精華
0 
積分
357 
點名
0  
作業系統
xp 
軟體版本
OFFIC 2007 
閱讀權限
20 
註冊時間
2010-6-4 
最後登錄
2015-8-19 
10#
發表於 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
複製代碼
50 字節以內
不支持自定義 Discuz! 代碼

TOP

        靜思自在 : 願要大、志要堅、氣要柔、心要細。
12
返回列表 上一主題