返回列表 上一主題 發帖

合併儲存格自動調整列高問題

合併儲存格自動調整列高問題

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

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


合併儲存格自動調整練習.rar (28.89 KB)
學習才能提升自己

回復 1# hugh0620


    謝謝前輩發表此主題與範例
後學藉此帖練習VBA,學習方案如下,請前輩參考
執行前:
20240514_1.jpg
2024-5-14 10:17


執行結果:
20240514_2.jpg
2024-5-14 10:17


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
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 2# Andy2483


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

TOP

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

大大的處理方式比較簡略,只是對我來說比較抽象。
(沒受過比較完整的編碼,所以,都是用最直覺的處理方式,撰寫程式碼。)
跨列合併儲存格_自動調整列高_完成品.rar (29.08 KB)
學習才能提升自己

TOP

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

回復 3# hugh0620


    謝謝前輩回復
後學修改方案如下,請前輩參考
執行前:
20240517-0.jpg
2024-5-17 08:04


執行結果:
20240517-1.jpg
2024-5-17 08:05


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
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 4# hugh0620


    謝謝前輩分享,這範例挺複雜的,恭喜能順利解決
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

本帖最後由 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而已。

我還是比較想用大大的版本,執行速度比較快。
看大大能不能克服上述的問題,那就更好被使用,感恩。
學習才能提升自己

TOP

        靜思自在 : 難行能行,難捨能捨,難為能為,才能昇華自我的人格。
返回列表 上一主題