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 (87.56 KB)

取消後儲存格

合併儲存格.rar (7.31 KB)

取消儲存格.rar (9.74 KB)

樓主熱帖

Hsieh

超級版主 Rank: 8 Rank: 8

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

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

2^#

發表於 2017-9-14 11:24 | 只看該作者

回復 1# hu0318s
基本操作比較繁雜
用VBA輔助吧

Sub 取消換行()
Dim A As Range, ar()
Set dic = CreateObject("Scripting.Dictionary")
With ActiveSheet
k = .Range(.[A1], .[A1].End(xlToRight)).Count
For Each A In .Columns("A:A").SpecialCells(xlCellTypeConstants)
ReDim ar(k)
For i = 0 To k - 1
ar(i) = Split(A.Offset(, i), Chr(10))
Next
dic(A.Value) = ar
Erase ar
Next
.Cells.ClearContents
r = 1: t = 1
For Each ky In dic.keys
For i = 0 To k - 1
ay = dic(ky)
t = IIf(UBound(ay(i)) + 1 > t, UBound(ay(i)) + 1, t)
.Cells(r, 1).Offset(, i).Resize(UBound(ay(i)) + 1, 1) = Application.Transpose(ay(i))
Next
r = r + t
Next
End With
End Sub

複製代碼

合併儲存格.zip (21.53 KB)

學海無涯_不恥下問

TOP

hu0318s

中學生 Rank: 2

帖子: 29
主題: 5
精華: 0
積分: 82
點名: 0
作業系統: XP
軟體版本: OFFICE2003
閱讀權限: 20
註冊時間: 2012-6-14
最後登錄: 2020-9-14

3^#

發表於 2017-9-16 14:31 | 只看該作者

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

TOP

hu0318s

中學生 Rank: 2

帖子: 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))

我附上我收到的檔案

下面是
我修改的

Sub 取消換行()
Dim A As Range, ar()
Set dic = CreateObject("Scripting.Dictionary")
With ActiveSheet
k = .Range(.[A1], .[A1].End(xlDown)).Count
For Each A In .Columns("A:A").SpecialCells(xlCellTypeConstants)
ReDim ar(k)
For i = 0 To k - 1
ar(i) = Split(A.Offset(i, i), Chr(10))
Next
dic(A.Value) = ar
Erase ar
Next
.Cells.ClearContents
r = 1: t = 1
For Each ky In dic.keys
For i = 0 To k - 1
ay = dic(ky)
t = IIf(UBound(ay(i)) + 1 > t, UBound(ay(i)) + 1, t)
.Cells(r, 1).Offset(i, i).Resize(UBound(ay(i)) + 1, 1) = Application.Transpose(ay(i))
Next
r = r + t
Next
End With

複製代碼

搞砸板.JPG (72.53 KB)

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

TOP