返回列表 上一主題 發帖

這樣的合併儲存格如何取消

hu0318s

帖子
29 
主題
5 
精華
0 
積分
82 
點名
0  
作業系統
XP 
軟體版本
OFFICE2003 
閱讀權限
20 
註冊時間
2012-6-14 
最後登錄
2020-9-14 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2017-9-13 21:53 | 只看該作者

這樣的合併儲存格如何取消

大大們 :最近收到檔案都是下面這樣的合併儲存格,我尋求過資料都沒有教學如何取消這樣的儲存格,我必須用mail傳給自己後再貼到新的活頁簿 可以跟大大們求救如何處理嗎

合併.JPG (106.28 KB)

合併.JPG

取消後儲存格.JPG (87.56 KB)

取消後儲存格

取消後儲存格.JPG

合併儲存格.rar (7.31 KB)

取消儲存格.rar (9.74 KB)

收藏 分享

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
2#
發表於 2017-9-14 11:24 | 只看該作者
回復 1# hu0318s
基本操作比較繁雜
用VBA輔助吧
  1. Sub 取消換行()
  2. Dim A As Range, ar()
  3. Set dic = CreateObject("Scripting.Dictionary")
  4. With ActiveSheet
  5. k = .Range(.[A1], .[A1].End(xlToRight)).Count
  6. For Each A In .Columns("A:A").SpecialCells(xlCellTypeConstants)
  7. ReDim ar(k)
  8.   For i = 0 To k - 1
  9.      ar(i) = Split(A.Offset(, i), Chr(10))
  10.   Next
  11.   dic(A.Value) = ar
  12.   Erase ar
  13. Next
  14. .Cells.ClearContents
  15. r = 1: t = 1
  16. For Each ky In dic.keys
  17.    For i = 0 To k - 1
  18.    ay = dic(ky)
  19.    t = IIf(UBound(ay(i)) + 1 > t, UBound(ay(i)) + 1, t)
  20.    .Cells(r, 1).Offset(, i).Resize(UBound(ay(i)) + 1, 1) = Application.Transpose(ay(i))
  21.    Next
  22.    r = r + t
  23. Next
  24. End With
  25. End Sub
複製代碼
合併儲存格.zip (21.53 KB)
學海無涯_不恥下問

TOP

hu0318s

帖子
29 
主題
5 
精華
0 
積分
82 
點名
0  
作業系統
XP 
軟體版本
OFFICE2003 
閱讀權限
20 
註冊時間
2012-6-14 
最後登錄
2020-9-14 
3#
發表於 2017-9-16 14:31 | 只看該作者
回復 2# Hsieh
謝謝大大的幫忙 立馬來用看看謝謝你:)

TOP

hu0318s

帖子
29 
主題
5 
精華
0 
積分
82 
點名
0  
作業系統
XP 
軟體版本
OFFICE2003 
閱讀權限
20 
註冊時間
2012-6-14 
最後登錄
2020-9-14 
4#
發表於 2017-9-16 16:43 | 只看該作者
本帖最後由 hu0318s 於 2017-9-16 16:48 編輯

回復 3# hu0318s

dear 大大:剛剛我有練習去處理,在10筆以內都比較沒問題,但像我常常收到檔案都是上千筆,變成好像只有前10筆可以完成 其他都會清空
我有練習去修改了解 ,但我發現我好想搞砸,可以請教大大. 在這邊的offiset 我要如何修改才可以把資料寫進儲存格  Cells(r, 1).Offset(, i).Resize(UBound(ay(i)) + 1, 1) = Application.Transpose(ay(i))

我附上我收到的檔案

下面是
我修改的
  1. Sub 取消換行()
  2. Dim A As Range, ar()
  3. Set dic = CreateObject("Scripting.Dictionary")
  4. With ActiveSheet
  5. k = .Range(.[A1], .[A1].End(xlDown)).Count
  6. For Each A In .Columns("A:A").SpecialCells(xlCellTypeConstants)
  7. ReDim ar(k)
  8.   For i = 0 To k - 1
  9.      ar(i) = Split(A.Offset(i, i), Chr(10))
  10.   Next
  11.   dic(A.Value) = ar
  12.   Erase ar
  13. Next
  14. .Cells.ClearContents
  15. r = 1: t = 1
  16. For Each ky In dic.keys
  17.    For i = 0 To k - 1
  18.    ay = dic(ky)
  19.    t = IIf(UBound(ay(i)) + 1 > t, UBound(ay(i)) + 1, t)
  20.    .Cells(r, 1).Offset(i, i).Resize(UBound(ay(i)) + 1, 1) = Application.Transpose(ay(i))
  21.    Next
  22.    r = r + t
  23. Next
  24. End With
複製代碼

搞砸板.JPG (72.53 KB)

搞砸板.JPG

合併儲存格1.rar (923.8 KB)

TOP

        靜思自在 : 【停滯不前，終無所得】人都迷於尋找奇蹟，因而停滯不前；縱使時間再多、路再長，也了無用處，終無所得。
返回列表 上一主題