返回列表 上一主題 發帖

請問:excel快速合併儲存格

jessicamsu

帖子
9 
主題
4 
精華
0 
積分
11 
點名
0  
作業系統
Windows 7 
軟體版本
office 2007 
閱讀權限
10 
性別
女 
註冊時間
2010-10-11 
最後登錄
2014-1-6 

論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2012-9-7 21:55 | 只看該作者

請問:excel快速合併儲存格

請問,如何將附件左邊的資料可以快速合併成右手邊的資料,謝謝

Book2.zip (6.98 KB)

收藏 分享
Jessica

chin15

帖子
227 
主題
3 
精華
1 
積分
273 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
性別
女 
註冊時間
2011-3-22 
最後登錄
2013-1-29 
2#
發表於 2012-9-7 22:47 | 只看該作者
用樞紐分析表
1

評分人數

TOP

jessicamsu

帖子
9 
主題
4 
精華
0 
積分
11 
點名
0  
作業系統
Windows 7 
軟體版本
office 2007 
閱讀權限
10 
性別
女 
註冊時間
2010-10-11 
最後登錄
2014-1-6 

論壇贊助勳章
3#
發表於 2012-9-8 10:12 | 只看該作者
樓上的大大先謝謝,但我因為要貼在另一個sheet並與其他資料彙整,所以樞紐並不適合,謝謝
Jessica

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
242  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-8 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
4#
發表於 2012-9-8 10:35 | 只看該作者
回復 3# jessicamsu
先用樞紐做出你的格式，再複製貼上就可以
學海無涯_不恥下問

TOP

chin15

帖子
227 
主題
3 
精華
1 
積分
273 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
性別
女 
註冊時間
2011-3-22 
最後登錄
2013-1-29 
5#
發表於 2012-9-8 10:43 | 只看該作者
應該是想練習循環吧？參考
  1. Sub test()
  2.     Dim c%, n%, i%, r%
  3.     Application.DisplayAlerts = False
  4.     n = [a65536].End(xlUp).Row
  5.     For c = 1 To 2
  6.         r = 2
  7.         For i = 2 To n
  8.             If Cells(i, c) <> Cells(i + 1, c) Then
  9.                 If r < i Then Range(Cells(r, c), Cells(i, c)).Merge
  10.                 r = i + 1
  11.             End If
  12.         Next
  13.     Next
  14. End Sub
複製代碼

TOP

jessicamsu

帖子
9 
主題
4 
精華
0 
積分
11 
點名
0  
作業系統
Windows 7 
軟體版本
office 2007 
閱讀權限
10 
性別
女 
註冊時間
2010-10-11 
最後登錄
2014-1-6 

論壇贊助勳章
6#
發表於 2012-9-8 18:35 | 只看該作者
謝謝chin15 大大,但經測試後,C欄沒有合併耶,不好意思,再麻煩您幫忙一下
Jessica

TOP

jessicamsu

帖子
9 
主題
4 
精華
0 
積分
11 
點名
0  
作業系統
Windows 7 
軟體版本
office 2007 
閱讀權限
10 
性別
女 
註冊時間
2010-10-11 
最後登錄
2014-1-6 

論壇贊助勳章
7#
發表於 2012-9-8 18:42 | 只看該作者
回復 5# chin15

謝謝chin15 大大,但經測試後,C欄沒有合併耶

將C改為c = 1 To 3, 但C欄黃色部份會有問題,正確應該要像右手邊一樣@@
[attach]12415[/attach]
Jessica

TOP

chin15

帖子
227 
主題
3 
精華
1 
積分
273 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
性別
女 
註冊時間
2011-3-22 
最後登錄
2013-1-29 
8#
發表於 2012-9-8 21:23 | 只看該作者
c欄不能納入循環中操作
  1. Sub test()
  2.     Dim c%, n%, i%, r%
  3.     Application.DisplayAlerts = False
  4.     n = [a65536].End(xlUp).Row
  5.     For c = 1 To 2
  6.         r = 2
  7.         For i = 2 To n
  8.             If Cells(i, c) <> Cells(i + 1, c) Then
  9.                 If r < i Then Range(Cells(r, c), Cells(i, c)).Merge
  10.                 r = i + 1
  11.             End If
  12.         Next
  13.     Next
  14.     For r = 2 To n
  15.         If Cells(r, 2).MergeCells Then
  16.             a = Cells(r, 2).MergeArea.Address
  17.             s = Split(a, "$")
  18.             For k = Val(s(2)) To Val(s(4))
  19.                 Do While Cells(k, 3).Offset(j, 0) = Cells(k, 3) And k + j <= Val(s(4))
  20.                     j = j + 1
  21.                 Loop
  22.                 If j > 1 Then
  23.                     Cells(k, 3).Resize(j).Merge
  24.                     k = k + j - 1
  25.                     j = 1
  26.                 End If
  27.             Next
  28.             r = k - 1
  29.         End If
  30.     Next
  31. End Sub
複製代碼

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
242  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-8 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
9#
發表於 2012-9-9 00:11 | 只看該作者
回復 7# jessicamsu
  1. Sub ex()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. Application.DisplayAlerts = False
  4. For i = 3 To 1 Step -1
  5.    For Each a In Range(Cells(2, i), Cells(Rows.Count, i).End(xlUp))
  6.    mystr = a & a.Offset(, IIf(i = 1, 0, -1))
  7.       If IsEmpty(d(mystr)) Then
  8.          Set d(mystr) = a
  9.          Else
  10.          Set d(mystr) = Union(d(mystr), a)
  11.       End If
  12.     Next
  13.     For Each ky In d.keys
  14.     d(ky).Merge
  15.     Next
  16.     d.RemoveAll
  17. Next
  18. Application.DisplayAlerts = True
  19. End Sub
複製代碼
學海無涯_不恥下問

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
10#
發表於 2012-9-9 10:36 | 只看該作者
回復 7# jessicamsu
Hsieh 前輩的 Idea 非常棒，我將它稍稍修飾了一下，
即先將 A2:C28 的內容複製到 E2:G28 後再處理分析，
以明確看得出來程式是如何執行處理的。
同時補上了 ky 的變數宣告。
  1. Sub ex()
  2.     Dim ky As Variant
  3.    
  4.     Set d = CreateObject("Scripting.Dictionary")
  5.     Application.DisplayAlerts = False
  6.    
  7.     [A2:C28].Copy Destination:=[E2]
  8.    
  9.     For i = 7 To 5 Step -1
  10.         For Each a In Range(Cells(2, i), Cells(Rows.Count, i).End(xlUp))
  11.             mystr = a & a.Offset(, IIf(i = 5, 0, -1))
  12.             If IsEmpty(d(mystr)) Then
  13.                 Set d(mystr) = a
  14.             Else
  15.                 Set d(mystr) = Union(d(mystr), a)
  16.             End If
  17.         Next
  18.         For Each ky In d.keys
  19.             d(ky).Merge
  20.         Next
  21.         d.RemoveAll
  22.     Next
  23.    
  24.     Application.DisplayAlerts = True
  25. End Sub
複製代碼
快速合併儲存格.rar (8.14 KB)

TOP

        靜思自在 : 做該做的事是智慧，做不該做的事是愚癡。
返回列表 上一主題