Board logo

標題: 這樣的合併儲存格如何取消 [打印本頁]
作者: hu0318s    時間: 2017-9-13 21:53     標題: 這樣的合併儲存格如何取消

大大們 :最近收到檔案都是下面這樣的合併儲存格,我尋求過資料都沒有教學如何取消這樣的儲存格,我必須用mail傳給自己後再貼到新的活頁簿 可以跟大大們求救如何處理嗎
作者: Hsieh    時間: 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
複製代碼
[attach]27739[/attach]
作者: hu0318s    時間: 2017-9-16 14:31

回復 2# Hsieh
謝謝大大的幫忙 立馬來用看看謝謝你:)
作者: hu0318s    時間: 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
複製代碼




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