Question

我在excel上构建一个工具，我需要检查文本是否适合单元格，如果不是，我必须合并单元格以适应文本。细胞是固定的我不能使用autofit或选项。请提前修改VB代码

Answer 1

在其他地方回答，但这是一个有效的基本代码。自动尺寸。

Sub merger()
Set c = ActiveSheet.Range("A:A").Find(what:="Executive Weekly Summary")
If Not c Is Nothing Then
startrow = c.Row + 1
endrow = ActiveSheet.Range("A" & startrow).End(xlDown).Row - 1
End If
  '"A" & startrow & ":I" & endrow
OldWidth = ActiveSheet.Range("A" & startrow & ":A" & endrow).ColumnWidth ' Save original width

ActiveSheet.Range("A" & startrow & ":A" & endrow).EntireColumn.AutoFit
fitwidth = ActiveSheet.Range("A:A").ColumnWidth ' Get width required to fit entire text

ActiveSheet.Range("A" & startrow & ":A" & endrow).ColumnWidth = OldWidth ' Restore original width

If OldWidth < fitwidth Then
Do Until OldWidth = fitwidth
    ActiveSheet.Range("").Merge
    endrow = endrow + 1

    OldWidth = ActiveSheet.Range("A" & startrow & ":A" & endrow).ColumnWidth
ActiveSheet.Range("A" & startrow & ":A" & endrow).EntireColumn.AutoFit
fitwidth = ActiveSheet.Range("A:A").ColumnWidth
ActiveSheet.Range("A" & startrow & ":A" & endrow).ColumnWidth = OldWidth
Loop
End If
End Sub

VB代码检查文本是否适合单元格

1 个答案: