Andy2483

¦^´_ 1# hugh0620


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾ÇÂǦ¹©«½m²ßVBA,¾Ç²ß¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò
°õ¦æ«e:

¤U¸ü (94 KB)

2024-5-14 10:17

°õ¦æµ²ªG:

¤U¸ü (84.81 KB)

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

Andy2483

¦^´_ 3# hugh0620


    ÁÂÁ«e½ú¦^´_
«á¾Ç­×§ï¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò
°õ¦æ«e:

¤U¸ü (123.95 KB)

2024-5-17 08:04

°õ¦æµ²ªG:

¤U¸ü (114.62 KB)

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 '¦pªG«á¤è¦h¥XªÅ¥ÕN­È§ï¤j¨Ò¦p:1.2,¦pªG«á¤è¦r¤¸³Q¾B¦íN­È§ï¤p¨Ò¦p: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

¦^´_ 4# hugh0620


    ÁÂÁ«e½ú¤À¨É,³o½d¨Ò®¼½ÆÂøªº,®¥³ß¯à¶¶§Q¸Ñ¨M