當前位置:
首頁 > 最新 > 如何將指定的多行數據合併到一個單元格中

如何將指定的多行數據合併到一個單元格中

Hello,各位小夥伴們大家好呀,又是N多天的等待,實在是不好意思,最近一來確實有點忙不過來,二來也因為沒看到什麼好玩的Excel問題可以衝動到可以放下手頭的工作來解題。這兩天正好閑下來,逛了逛貼吧,就看到了一個好玩的問題——《關於多行內容合併如一個格子的問題》。完整題目如下:

如上圖所示 我想讓畫藍色框框的內容複製到紅色箭頭指向的格子(這個格子是合併後的格子),但我想批量做,因為類似的任務有上百個在同一個sheet裡面,但每個要合併的內容行數還不太一樣。。。。有解嗎?大神們= =

Yogurt看到之後思考了幾分鐘,想到了解決的思路,然後不到7分鐘寫出了一個初步的解決方案,並且測試通過。後面進行了多次修改之後在這裡分享給大家。這是Yogurt第一次在公眾號上詳細的講解VBA的設計思路和個人的編寫規範,如果有講不明白或者表述不清楚的地方,大家可以通過在下面留言或者直接在公眾號上向Yogurt提出建議。萬分感謝大家,And Now,Here We Go!

按照他的描述,最終的結果應該是這樣的:

然後,Yogurt的代碼運行過程是這樣的:

GIF

這麼多需要處理的數據,一秒不到就完成了,如果是手動怕是要做到很晚。這也就是Excel中最具有魅力的地方了,無論你的數據有多龐大,只要找到其中的規律,一切都能迎刃而解。

以下是這不到一秒鐘里Excel後台執行的代碼。也就是咱們本次的分享內容。

VBA的學習比較靈活,主要以思路為主,不過Yogurt的思路也只是一家之言,難免會有遺漏之處,因此大家在接受之餘,也需要多多的思考是否還有比Yogurt更加簡便的方法和更加清晰的思路。

1

前期準備

然後,我們先來分析這個表的特點。

1、這裡每一組數據的行數都不一樣,從直觀的角度上來看,這是毫無規律可言的,單純使用函數來解決這個問題就比較困難了。因此首先排除使用函數法來完成這項工作。

2、C列的內容是D列相對應的集合,而且還要換行來表示。

2

分析處理過程

在這種數據但是我們可以從手動操作的方式上著手。想像一下,如果讓我們不通過任何函數和技巧來完成這個工作會怎麼做?當然是一個個複製粘貼過去對不對。

那麼我們需要把複製粘貼過程中大腦的思考過程一步步整理出來。

首先,我們會判斷哪些單元格是需要複製粘貼的。比如第一個合併單元格中,需要將D1到D6的內容一個個複製到C1的合併單元格中。

判斷完畢之後,我們會動手去執行這個步驟,接著在執行下一個將D7到D11複製到C7的合併單元格中。然後以此類推。

在這個過程中,我們會發現,我們是通過判斷【C列合併單元格的行數】來複制粘貼相對應【D列單元格的內容】。

3

編寫初級代碼

3.1 獲取單元格區域

按照我們上面分析出來的處理方案,我們可以來編寫初級的代碼了。

首先我們需要通過代碼來確認C列合併單元格的位置,也就是B列合併單元格的位置。而合併單元格的特點——合併單元格的單元格地址實際上是以合併單元格區域的起始單元格為地址。比如:合併單元格C1:C6的地址為C1;合併單元格C6:D12的地址為C6。

同時,除了該地址之外的單元格的內容都是空的。如下圖。

GIF

這裡用公式來獲取B列合併單元格的內容發現除了第一個單元格有內容之外,其他都為0(也就是空的)。

因此我們可以通過代碼來獲取當B列內容為不為空時的行數。

GIF

Sub TEST()

With Sheet1

.Range("E:E").Clear "先清除E列的內容

Dim UseCount As Integer, RangeCount As Integer

UseCount = .Range("D1000").End(xlUp).Row

For i = 1 To UseCount

If .Range("B" & i) "" Then .Range("E" & i) = i

Next

.Range("E" & UseCount + 1) = UseCount + 1

End With

End Sub

先通過End(xlUp).Row來獲取D列中最後一行的行數,並且賦值給UseCount。

通過這段代碼來獲取B列合併單元格的位置,原理是當B列中的單元格不為空時,輸出單元格的行數。

然後按照前面獲取行數的規律,最後一行的行數就直接輸出為UseCount+1,也就是獲取單元格區域的最後一行的下一行。(這裡如果不明白的話,可以留言或在公眾號中私聊Yogurt)

這樣我們就得到了合併單元格的位置,也就意味著獲得了"複製粘貼"D列單元格內容的區域。

3.2 整合獲取的行數

但是上面的操作的表現不是特別的直觀,我們需要對這些數據進行整合一下。(增加或者修改的代碼會通過藍色來標註,大家可以對比一下前後的區別)

GIF

Sub TEST()

With Sheet1

.Range("E:E").Clear "先清除E列的內容

Dim UseCount As Integer,RangeCount As Integer

UseCount = .Range("D1000").End(xlUp).Row

For i = 1 To UseCount

RangeCount = .Range("E1000").End(xlUp).Row

If .Range("B" & i) "" Then

If i = 1 Then

.Range("E" & RangeCount) = i

Else

.Range("E" & RangeCount + 1) = i

End If

End If

Next

RangeCount = RangeCount + 1

.Range("E" & RangeCount) = UseCount + 1

End With

End Sub

通過每次循環獲取E列增加的行數來增加下一個獲取B列單元格不為空的行數,可以直觀的了解行數分布的情況,同時也方便下一步的操作。

因為當E列為空時,End(xlUp).Row方法獲取到的行數為1而不是0,如果直接用.Range("E" & RangeCount) = i的話,那麼所有的值都會在E1這個位置;而直接用.Range("E" & RangeCount+1) = i的話,那麼所有的值都會從E2開始往下,則將E1空出來,不便於後續的操作(同時也不符合強迫證患者的審美觀,哈哈哈)。所以我們需要增加一次判斷來結合兩者使其更加完善。

3.3 獲取D列數據

我們通過上一個步驟獲得了複製D列單元格的區域位置範圍,那麼就可以通過獲取的數據進行獲取D列的數據到C列中了。

GIF

Sub TEST()

With Sheet1

.Range("E:E").Clear "先清除E列的內容

Dim UseCount As Integer, RangeCount As Integer

UseCount = .Range("D1000").End(xlUp).Row

For i = 1 To UseCount

RangeCount = .Range("E1000").End(xlUp).Row

If .Range("B" & i) "" Then

If i = 1 Then

.Range("E" & RangeCount) = i

Else

.Range("E" & RangeCount + 1) = i

End If

End If

Next

RangeCount = RangeCount + 1

.Range("E" & RangeCount) = UseCount + 1

.Range("C:C").ClearContents "先清除C列的內容

Dim k As Integer

k = 1

For i = 1 To UseCount

If .Range("B" & i) "" Then

For j = .Range("E" & k) To .Range("E" & k + 1) - 1

.Range("C" & i) = .Range("C" & i) & vbCrLf & .Range("D" & j)

Next

.Range("C" & i) = Replace(.Range("C" & i), vbCrLf, "", , 1)

k = k + 1

End If

Next

End With

End Sub

所增加的藍色部分就是模擬我們手動複製粘貼過程中大腦如何判斷以及如何動手操作的步驟。

通過判斷B列不為空的單元格的位置來確定C列合併單元格的位置,然後獲取E列相鄰兩個單元格數據作為循環"複製粘貼"D列區域的起始和末尾位置。需要注意的是,我們前面獲取的行數都是以起始位置為目標的,所以當E列數據在作為末尾位置時要減1。

換行符的輸入在Excel單元格中是快捷鍵【Alt+Enter】,但在VBA中有更簡單的表示-【vbCrLf】。而在循環過程中換行符始終多一個,那麼就可以在處理完之後刪除最前面的那個換行符即可,這裡用的是Replace函數。

然後到這裡這個操作就完成了。

當然,可能有些小夥伴會覺得多出來一個E列作為輔助列很難看,我們可以再把第一行刪除E列內容的代碼複製到End With前面,這樣就可以在執行完代碼後清除E列的內容。如下圖。

GIF

以上方法呢,是用VBA代碼結合了新建一個Excel的輔助列來完成的,如果想完全脫離輔助列的話,則需要用到數組的方法。但是由於這期內容對於剛接觸VBA的小夥伴們來說本身理解起來可能就比較複雜。這裡就不再多說了,直接上代碼,等大家理解了前面的內容之後,再來看下面的內容也許就會不言而喻了。

下面的代碼Yogurt按照VBA的標記顏色對其進行了上色,可以讓大家在看代碼的同時可以像在編輯器中一樣一目了然。具體的代碼在Excel文件中直接看。可以通過回復【合併】來獲得。

PS:使用WPS的小夥伴需要安裝WPS的VBA組件才可以使用VBA。

SubTEST()

WithSheet1

"準備階段

.Range("C:C").Clear"清除C列中數據即格式

"定義數據類型

Dimk()As Integer"定義一個整型數組k(),用於存放獲取到的數據

DimksAs Integer"定義一個整型ks,作為整型數組k()的序列號

DimUseCountAs Integer"定義一個整型UseCount,用於記錄統計【合併單元格】的總數量

DimEndRowAs Integer"定義一個整型EndRow,用於記錄需要進行合併的數據的最後一行的行數,同時也是總行數

UseCount = Application.WorksheetFunction.CountA(Range("A1:A1000"))"調用Excel函數CountA獲取【合併單元格】的數量,並賦值給UseCount

EndRow = .Range("D1000").End(xlUp).Row"使用End()方法獲取需要合併的數據的最後一行的函數,並賦值給EndRow

"獲取對應單元格的單元格地址

ks = 0"使ks為零

ReDimk(UseCount)"重新定義數組k()的數組元素的數量

Fori = 1ToEndRow"設置循環判斷,從第一行到需要合併的數據的最後一行

If.Range("B" & i) ""Then"通過If...Then方法來獲取當合併單元格的值不為空時

k(ks) = i"數組k(ks)的值為i,i為行數

End If

Next

k(UseCount) = EndRow"設置數組k()的最後一位為需要合併的數據的最後一行的行數

"執行輸出

ks = 0"重置ks為0

Fori = 1ToEndRow"設置循環判斷,從第一行到需要合併的數據的最後一行

If.Range("B" & i) ""Then"通過If...Then方法來獲取當合併單元格的值不為空時

Forj = k(ks)Tok(ks + 1)"即進入從數組k()相鄰的兩個元素之間的循環值,如不能理解,詳細解釋請見公眾號

.Range("C" & i) = .Range("C" & i) & vbCrLf & .Range("D" & j)"輸出值到相對應合併單元格中的C列所對應的行中

Next

.Range("C" & k(ks)) = Replace(.Range("C" & k(ks)), vbCrLf, "", , 1)"將多餘的回車符刪除,保留最終結果

Ifks

.Range("C" & k(ks) & ":C" & k(ks + 1) - 1).Merge"如是,則需要少合併一個單元格

Else

.Range("C" & k(ks) & ":C" & k(ks + 1)).Merge"如不是,則直接合併單元格

End If

ks = ks + 1"然後ks+1,進入下一個循環

End If

Next

Cells.EntireRow.AutoFit"執行單元格行高的自動調整

.Range("C:C").ColumnWidth = 100"執行單元格列寬的調整

.Range("C:C").EntireColumn.AutoFit"執行單元格列寬的自動調整

End With

End Sub

嗯~~最後在多說一點,我們使用Excel是為了使工作更加方便,而有些時候是為了展示數據,很多東西不得已而為之。這個案例的Excel整理的做法,Yogurt個人是不太提倡的。如果僅僅是用於展示,其實可以通過對單元格進行【邊框和底紋】的處理。將所有的數據堆在一個單元格里對後期的數據維護是一個很大的弊端。

我們提倡的是資料庫式的Excel數據管理思維——表頭和合併單元格一律在最上方,左側最多只能是序號。如下圖。

而且最好是把所有的數據都分類存放,而不是各種參數堆在一個單元格里。

如果大家不理解什麼是資料庫式的管理,可以看一下自己的Office文件夾,一般會有一個ACCESS資料庫,點進去自己新建一個數據表之後就理解了。在資料庫裡面,根本就沒有合併單元格這一說法,數據之所以為數據就是用來處理的,如果有各種各樣的東西影響處理的話,那麼我們數據的處理結果是不準確的,也增加了數據處理的難度和造成工作效率的下滑風險。

最後希望大家在新的一年裡,數據處理有聲有色,大有進步!

我是Yogurt,下期再見咯!


喜歡這篇文章嗎?立刻分享出去讓更多人知道吧!

本站內容充實豐富,博大精深,小編精選每日熱門資訊,隨時更新,點擊「搶先收到最新資訊」瀏覽吧!


請您繼續閱讀更多來自 創雲設計工作室 的精彩文章:

TAG:創雲設計工作室 |