麻辣家族討論版版 - Powered by Discuz! Board

標題: 合併儲存格自動調整列高問題 [打印本頁]

作者: hugh0620 時間: 2024-5-11 09:42 標題: 合併儲存格自動調整列高問題

本帖最後由 hugh0620 於 2024-5-11 09:47 編輯

各位大大，附件是我在工作處理上的一個問題，有在討論區搜尋"合併儲存格"的帖子。
但沒有找到有關於合併儲存格後自動調整列高的討論。(或許有疏漏沒看到，也請指正)
單一儲存格可以在VBA設定自動調整列高，但在合併儲存格我測試就不行了。
一般表格多數會設定列印為"一頁寬度"，列長就不會有設限。(條件)
試著用ChatGPT來解答，但成果沒有達到。(應該有可能是我描述的意思不夠清楚)
也看到網站有在教如何計算字的列高，就湊出附件的結果。
大致有了一個比較可以讓儲存格內容，可以在字體、字大小、欄寬固定下，讓合併儲存格可以自動調整列高。
我的方式是比較笨的，先跑出字體、大小的列高資料，將其設定為一個查詢的資料檔。
在一此作為計算合併儲存格自動調整。
附件有2個工作表。
第1個模擬是每一列的字數，沒有超過欄寬下，是可以解決將所有合併儲存格的內容顯示出來。
第2個模擬是比較實際作業面的，每一列的字數有可能會超過欄寬，如果遇到這個情況，我的方法就沒法解決。
不知道，各位大大有沒有其他更好的方式來處理第2個條件下的合併儲存格自動調整。
條件：合併儲存格下，不能用"字型符合欄寬"、"字型、大小不能調整"、"欄寬是固定的"。
請大大們不吝解惑。

[attach]37761[/attach]

作者: Andy2483 時間: 2024-5-14 10:18

回復 1# hugh0620

謝謝前輩發表此主題與範例
後學藉此帖練習VBA,學習方案如下,請前輩參考
執行前:
[attach]37762[/attach]

執行結果:
[attach]37763[/attach]

Option Explicit
Sub Test()
Dim i&, ii&, Rah, xR As Range
For i = [C65536].End(3).Row To 1 Step -1
If Cells(i, 3).MergeArea.Count > 1 And Cells(i, 3) <> "" Then
   Set xR = Cells(i, 3).MergeArea
   For ii = 2 To Cells(i, 3).MergeArea.Count
      Rah = Rah + xR(ii).RowHeight
   Next
   Cells(i, 3).UnMerge
   Rows(i).AutoFit
   xR.Merge
   Rows(i).RowHeight = Rows(i).RowHeight - Rah
   Rah = 0
End If
Next
End Sub

作者: hugh0620 時間: 2024-5-15 18:10

回復 2# Andy2483

感恩唷!!
可以再修改一下嗎?? (我有試著用你的程式碼去修改我需要的，但失敗，呵呵。)
用3*3的合併儲存格模式，可以自動調整列高。
原本我以為只是1欄，3個列的合併儲存格，結果是，3欄*3列。

作者: hugh0620 時間: 2024-5-16 16:32

回復 2# Andy2483
這是我用比較笨的方式，用湊的方式完成，不過，還是用了一個輔助欄位來處理。
如果儲存格資料比較多的時候，就會跑得比較慢一點點，但還算是可以順利完成合併儲存格的獵高自動調整。
我採用的方式比較土方法，將合併儲存格的內容，將每一列的資料抓出來放在輔助欄位中，
在將輔助欄位中每一個字逐一還原成跟合併儲存格的字體、大小一模一樣後，
而欄寬，也是先統計好合併儲存格的欄寬數字，再套用設定輔助欄位的欄寬，用自動調整列高，取的列高的數字。
(在這個階段是只有一個儲存格，所以列高是可以VBA來自動調整的。)
逐一將儲存格內容每一列依上述方式處理，可以得到最後的列高。
剩下就是累計列高減掉固定欄位列高後，再平均分配到浮動欄位設定列高。

大大的處理方式比較簡略，只是對我來說比較抽象。
(沒受過比較完整的編碼，所以，都是用最直覺的處理方式，撰寫程式碼。)
[attach]37764[/attach]

作者: Andy2483 時間: 2024-5-17 08:06

本帖最後由 Andy2483 於 2024-5-17 08:36 編輯

回復 3# hugh0620

謝謝前輩回復
後學修改方案如下,請前輩參考
執行前:
[attach]37765[/attach]

執行結果:
[attach]37766[/attach]

Option Explicit
Sub TEST_RxC()
Dim i&, ii&, Rah, CaW, xR As Range, R&, cW, cW1, C%, N
N = 1 '如果後方多出空白N值改大例如:1.2,如果後方字元被遮住N值改小例如:0.8
For i = 1 To [C65536].End(3).MergeArea.Row
If Cells(i, 3).MergeArea.Count > 1 And Cells(i, 3) <> "" Then
   Set xR = Cells(i, 3).MergeArea
   C = xR.Columns.Count
   R = xR.Rows.Count
   cW1 = xR(1).Columns.ColumnWidth
   For ii = 1 To C
      CaW = CaW + xR(ii).Columns.ColumnWidth
   Next
   For ii = 2 To R
      Rah = Rah + xR(ii).Rows.RowHeight
   Next
   xR.UnMerge
   xR(1).Columns.ColumnWidth = CaW + xR.Font.Size / CaW * N
   Rows(i).AutoFit
   xR.Merge
   xR(1).Columns.ColumnWidth = cW1
   xR(1).Rows.RowHeight = xR(1).Rows.RowHeight - Rah + xR.Font.Size * 0.5
   Rah = 0: CaW = 0
End If
Next
End Sub

作者: Andy2483 時間: 2024-5-17 08:17

回復 4# hugh0620

謝謝前輩分享,這範例挺複雜的,恭喜能順利解決

作者: hugh0620 時間: 2024-5-17 16:01

本帖最後由 hugh0620 於 2024-5-17 16:03 編輯

回復 5# Andy2483

我用大大的方式來測試，還差一點點。
大大的第一個版本，反而是比較完美的，只是如果是在3R*3C的無法正常使用，
另外，版本1的部分好像只是調整列1而已，需要的結果是列1跟列3要平均調整列高。
大大的第二個版本，因為有用到"xR.Font.Size * 0.5"的計算，如果今天儲存格的字體不一樣時，
xR.Font.Size 就是Null，這段程式碼就沒有作用。
同樣的跟版本1的部分好像都只是調整列1而已。

我還是比較想用大大的版本，執行速度比較快。
看大大能不能克服上述的問題，那就更好被使用，感恩。

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