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

hu0318s

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

Hsieh

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

下載次數: 6

2017-9-14 11:24

hu0318s

回復 2# Hsieh
謝謝大大的幫忙 立馬來用看看謝謝你:)

hu0318s

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

複製代碼