autofit_AutoFit合并的单元格行高更新20151203

本文介绍了在Excel中遇到合并单元格行高自动调整问题的解决方案。作者提供了由Smallman改进的VBA代码,该代码能够智能判断合并单元格中哪个包含最多文本,并据此设置行高,解决了当行中存在多个合并单元格时,双击调整行高不准确的问题。同时,文章警告使用此类宏会清除撤销历史,并提供了在不同情况下运行代码的建议。
摘要由CSDN通过智能技术生成

autofit

Way back in June 2012, I posted some sample code for adjusting the row height in merged cells. It's been 3-1/2 years, and people are still commenting on that article!

早在2012年6月,我发布了一些示例代码来调整合并单元格中的行高 。 已经有3-1 / 2年了,人们仍然在评论那篇文章!

Apparently it is a common problem, and even though I don't like merged cells, sometimes we just have to deal with them.

显然,这是一个普遍的问题,即使我不喜欢合并的单元格,有时我们也只需要处理它们。

AutoFit Merged Cells in Excel http://blog.contextures.com/

自动调整问题 (The AutoFit Problem)

To quickly summarize the problem – if cells are merged, the rows don't AutoFit correctly when you double-click in the row button area.

为了快速总结问题–如果合并单元格,则在行按钮区域中双击时,行将无法正确进行自动调整。

For example, the text doesn't fit in the merged cell below.

例如,该文本不适合下面的合并单元格。

mergedcellsautofit01

When I double-click the line between row buttons 10 and 11, the row height is reduced to fit one line of text, instead of expanding to fit all 3 lines of text.

当我双击行按钮10和11之间的行时,行高将减小以适合一行文本,而不是扩展以适合所有3行文本。

mergedcellsautofit02

To show the full note in the merged cell, I have to manually adjust the row height.

要在合并的单元格中显示完整的笔记,我必须手动调整行高。

That's why I created a macro to automatically adjust the row height for merged cells.

这就是为什么我创建了一个宏来自动调整合并单元格的行高的原因。

帮助问题 (Help With Questions)

Throughout the comments in the original blog post, Smallman has answered many questions, and adjusted the code to meet new requirements, such as multiple merged ranges on a worksheet. Thanks Smallman!

在原始博客文章中的所有评论中, Smallman回答了许多问题,并调整了代码以满足新要求,例如工作表上的多个合并范围。 谢谢Smallman!

Recently, he posted a new version of the code, and included a link where you can download his sample file. To make the code easier to find, I've put it in this update article, so it isn't buried in the comments!

最近,他发布了该代码的新版本,并提供了一个链接,您可以在其中下载他的示例文件。 为了使代码更易于查找,我将其放置在此更新文章中,因此它没有包含在注释中!

有关使用代码的注意事项 (Notes on Using the Code)

Warning: Like other macros that change the worksheet, this code will wipe out the Undo stack, so you won't be able to undo any steps you've previously taken. If other people will be using the code, let them know about this!

警告 :与更改工作表的其他宏一样,此代码将清除“撤消”堆栈,因此您将无法撤消以前执行的任何步骤。 如果其他人将使用该代码,请告知他们!

In the original example, the code ran when the Order Form Note was changed – that triggered the Worksheet_Change event. You could use the workbook's BeforePrint event, to reduce the Undo problem. Or, use a button on the worksheet, like the one in Smallman's sample file.

在原始示例中,代码在更改订单表单注释时运行–触发了Worksheet_Change事件。 您可以使用工作簿的BeforePrint事件来减少“撤消”问题。 或者,使用工作表上的按钮,如Smallman的示例文件中的按钮。

Also, if your worksheet is protected, you can add code to unprotect and protect the worksheet.

另外,如果您的工作表受到保护,则可以添加代码以取消保护并保护工作表。

改进的AutoFit合并单元格代码 (Improved AutoFit Merged Cells Code)

Below is Smallman's code, and his description of what the code does. I wrapped some of the lines, to make it fit better in the blog post. If you download his sample file, the code will look a bit different.

下面是Smallman的代码,以及他对代码功能的描述。 我包装了一些文字,以使其更适合博客文章。 如果下载他的样本文件,则代码看起来会有所不同。

Go to the AutoFit Merged Cells with VBA page on Smallman's site, to download his sample file.

转到Smallman网站上“带有VBAAutoFit合并单元”页面 ,以下载他的示例文件。

From Smallman's comment on the original article:

来自Smallman对原始文章的评论:

I have been working on a problem which has been raised quite a bit in this blog regarding the problem of when you have multiple merged cells in the same line. Nothing to date has dealt with this problem and I think I have an answer. The following will look at all cells in a given line and work out which cell has the 'most' text. It will then make that cell the big daddy and it will dictate how tall the row height is for the entire row.

我一直在处理一个问题,该问题在本博客中已经提出了很多有关同一行中有多个合并单元格的问题。 迄今为止,没有任何东西可以解决这个问题,我想我有一个答案。 下面将查看给定行中的所有单元格,并找出哪个单元格具有“最多”的文本。 然后,它将使该单元格成为大爸爸,并决定整个行的行高有多高。

For those interested in an example I put a new tab in the workbook on my own site as I can't upload files here. It works nicely. The tab which performs the magic is the red one at the end. Here is the coding for those interested.

对于那些对示例感兴趣的人,我在自己的站点上的工作簿中放置了一个新标签,因为我无法在此处上传文件。 效果很好。 执行魔术的选项卡的末尾是红色的。 这是那些感兴趣的代码。

'-----------------------------

'-----------------------------

Option Explicit

Sub MergedAreaRowAutofit()
Dim j As Long
Dim n As Long
Dim i As Long
Dim MW As Double 'merge width
Dim RH As Double 'row height
Dim MaxRH As Double
Dim rngMArea As Range
Dim rng As Range
 
Const SpareCol  As Long = 26
Set rng = Range("C10:O" & _
  Range("C" & Rows.Count).End(xlUp).Row)

With rng
  For j = 1 To .Rows.Count
     'if the row is not hidden
    If Not .Parent.Rows(.Cells(j, 1).Row) _
      .Hidden Then
       'if the cells have data
      If Application.WorksheetFunction _
        .CountA(.Rows(j)) Then
        MaxRH = 0
        For n = .Columns.Count To 1 Step -1
          If Len(.Cells(j, n).Value) Then
             'mergecells
            If .Cells(j, n).MergeCells Then
              Set rngMArea = _
                .Cells(j, n).MergeArea
              With rngMArea
                MW = 0
                If .WrapText Then
                   'get the total width
                  For i = 1 To .Cells.Count
                    MW = MW + _
                      .Columns(i).ColumnWidth
                  Next
                  MW = MW + .Cells.Count * 0.66
                   'use the spare column
                   'and put the value,
                   'make autofit,
                   'get the row height
                  With .Parent.Cells(.Row, SpareCol)
                    .Value = rngMArea.Value
                    .ColumnWidth = MW
                    .WrapText = True
                    .EntireRow.AutoFit
                    RH = .RowHeight
                    MaxRH = Application.Max(RH, MaxRH)
                    .Value = vbNullString
                    .WrapText = False
                    .ColumnWidth = 8.43
                  End With
                  .RowHeight = MaxRH
                End If
              End With
            ElseIf .Cells(j, n).WrapText Then
              RH = .Cells(j, n).RowHeight
              .Cells(j, n).EntireRow.AutoFit
              If .Cells(j, n).RowHeight < RH Then _
                .Cells(j, n).RowHeight = RH
            End If
          End If
        Next
      End If
    End If
  Next
  .Parent.Parent.Worksheets(.Parent.Name).UsedRange
End With
End Sub

翻译自: https://contexturesblog.com/archives/2015/12/03/autofit-merged-cells-row-height-update-20151203/

autofit

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值