返回列表 上一主題 發帖

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

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

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

取消後儲存格

取消後儲存格.JPG

合併儲存格.rar (7.31 KB)

取消儲存格.rar (9.74 KB)

請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

回復 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

回復 2# Hsieh
謝謝大大的幫忙 立馬來用看看謝謝你:)
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

本帖最後由 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

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

請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

        靜思自在 : 道德是提昇自我的明燈,不該是呵斥別人的鞭子。
返回列表 上一主題