Note: The other languages of the website are Google-translated. Back to English
Log in  \/ 
x
or
x
Inscreva-se  \/ 
x

or

Como ajustar automaticamente a altura da linha de células mescladas no Excel?

No Excel, podemos ajustar rapidamente a altura da linha para caber no conteúdo da célula usando o AutoAjustar Altura da linha recurso, mas esta função irá ignorar completamente as células mescladas. Ou seja, você não pode aplicar o AutoAjustar Altura da linha recurso para redimensionar a altura da linha das células mescladas, você precisa ajustar manualmente a altura da linha para as células mescladas, uma a uma. Neste artigo, posso apresentar alguns métodos rápidos para resolver esse problema.

Ajuste automático da altura da linha de células mescladas com código VBA

Guia Office Habilite a edição e navegação com guias no Office e torne seu trabalho muito mais fácil ...
O Kutools for Excel resolve a maioria dos seus problemas e aumenta sua produtividade em 80%
  • Reutilizar qualquer coisa: Adicione as fórmulas, gráficos e tudo mais usados ​​ou complexos aos seus favoritos e reutilize-os rapidamente no futuro.
  • Mais de 20 recursos de texto: Extrair número da string de texto; Extraia ou remova parte dos textos; Converta números e moedas para palavras em inglês.
  • Ferramentas de mesclagem: Várias pastas de trabalho e planilhas em um; Mesclar várias células / linhas / colunas sem perder dados; Mesclar linhas duplicadas e soma.
  • Ferramentas de divisão: Divida os dados em várias folhas com base no valor; Uma pasta de trabalho para vários arquivos do Excel, PDF ou CSV; Uma coluna para várias colunas.
  • Paste Skipping Linhas ocultas / filtradas; Contagem e soma por cor de fundo; Envie emails personalizados para vários destinatários em massa.
  • Super Filtro: Crie esquemas de filtro avançados e aplique a qualquer planilha; tipo por semana, dia, frequência e muito mais; filtros por negrito, fórmulas, comentário ...
  • Mais de 300 recursos poderosos; Funciona com Office 2007-2019 e 365; Suporta todos os idiomas; Fácil implantação em sua empresa ou organização.

seta azul bolha direita Ajuste automático da altura da linha de células mescladas com código VBA


Supondo que eu tenha uma planilha com algumas células mescladas conforme a captura de tela mostrada a seguir, e agora eu precise redimensionar a altura da linha da célula para exibir todo o conteúdo, o código VBA abaixo pode ajudá-lo a ajustar automaticamente a altura da linha de várias células mescladas. do seguinte modo:

doc-autofit-merged-cells-1

1. Segure o ALT + F11 chaves, e abre o Janela Microsoft Visual Basic for Applications.

2. Clique inserção > Móduloe cole o seguinte código no Janela Módulo.

Código VBA: ajuste automático da altura da linha de várias células mescladas
Option Explicit
Public Sub AutoFitAll()
  Call AutoFitMergedCells(Range("a1:b2"))
   Call AutoFitMergedCells(Range("c4:d6"))
    Call AutoFitMergedCells(Range("e1:e3"))
End Sub
Public Sub AutoFitMergedCells(oRange As Range)
  Dim tHeight As Integer
  Dim iPtr As Integer
  Dim oldWidth As Single
  Dim oldZZWidth As Single
  Dim newWidth As Single
  Dim newHeight As Single
  With Sheets("Sheet4")
    oldWidth = 0
    For iPtr = 1 To oRange.Columns.Count
      oldWidth = oldWidth + .Cells(1, oRange.Column + iPtr - 1).ColumnWidth
    Next iPtr
    oldWidth = .Cells(1, oRange.Column).ColumnWidth + .Cells(1, oRange.Column + 1).ColumnWidth
    oRange.MergeCells = False
    newWidth = Len(.Cells(oRange.Row, oRange.Column).Value)
    oldZZWidth = .Range("ZZ1").ColumnWidth
    .Range("ZZ1") = Left(.Cells(oRange.Row, oRange.Column).Value, newWidth)
    .Range("ZZ1").WrapText = True
    .Columns("ZZ").ColumnWidth = oldWidth
    .Rows("1").EntireRow.AutoFit
    newHeight = .Rows("1").RowHeight / oRange.Rows.Count
    .Rows(CStr(oRange.Row) & ":" & CStr(oRange.Row + oRange.Rows.Count - 1)).RowHeight = newHeight
    oRange.MergeCells = True
    oRange.WrapText = True
    .Range("ZZ1").ClearContents
    .Range("ZZ1").ColumnWidth = oldZZWidth
  End With
End Sub

notas:

(1.) No código acima, você pode adicionar novos intervalos, basta copiar Chame AutoFitMergedCells (Range ("a1: b2")) faça o script quantas vezes quiser e altere os intervalos de células mesclados de acordo com suas necessidades.

(2.) E você deve alterar o nome da planilha atual Sheet4 ao nome da folha usada.

3. Então aperte F5 para executar este código, e agora você pode ver que todas as células mescladas foram ajustadas automaticamente ao conteúdo da célula, consulte a captura de tela:

doc-autofit-merged-cells-1


Artigo relacionado:

Como ajustar automaticamente a largura da coluna no Excel?


As melhores ferramentas de produtividade para escritório

O Kutools for Excel resolve a maioria dos seus problemas e aumenta sua produtividade em 80%

  • armadilha para peixes: Insira rapidamente fórmulas complexas, gráficos e qualquer coisa que você tenha usado antes; Criptografar células com senha; Criar lista de discussão e enviar emails ...
  • Super Formula Bar (edite facilmente várias linhas de texto e fórmula); Layout de leitura (ler e editar facilmente um grande número de células); Colar na faixa filtrada...
  • Mesclar células / linhas / colunas sem perder dados; Dividir o conteúdo das células; Combinar linhas / colunas duplicadas... Evite células duplicadas; Comparar intervalos...
  • Selecione Duplicado ou Único Linhas; Selecione linhas em branco (todas as células estão vazias); Super Find e Fuzzy Find em muitos livros; Seleção aleatória ...
  • Cópia exata Várias células sem alterar a referência da fórmula; Criação automática de referências para várias folhas; Inserir marcadores, Caixas de seleção e mais ...
  • Extrair Texto, Adicionar texto, remover por posição, Remover Espaço; Criar e imprimir subtotais de paginação; Converter entre conteúdo de células e comentários...
  • Super Filtro (salvar e aplicar esquemas de filtro a outras planilhas); Classificação Avançada por mês / semana / dia, frequência e mais; Filtro Especial por negrito, itálico ...
  • Combine pastas de trabalho e planilhas; Mesclar tabelas com base em colunas-chave; Divida os dados em várias folhas; Conversão em lote de xls, xlsx e PDF...
  • Mais de 300 recursos poderosos. Suporta Office / Excel 2007-2019 e 365. Suporta todos os idiomas. Fácil implantação em sua empresa ou organização. Teste gratuito de 30 dias com recursos completos. Garantia de devolução do dinheiro em 60 dias.
guia kte 201905

Guia do Office traz interface com guias para o Office e torna seu trabalho muito mais fácil

  • Habilite a edição e leitura com guias em Word, Excel, PowerPoint, Publisher, Access, Visio e Project.
  • Abra e crie vários documentos em novas guias da mesma janela, em vez de em novas janelas.
  • Aumenta sua produtividade em 50% e reduz centenas de cliques do mouse para você todos os dias!
officetab bottom

<p >


As melhores ferramentas de produtividade para escritório

O Kutools for Excel resolve a maioria dos seus problemas e aumenta sua produtividade em 80%

  • armadilha para peixes: Insira rapidamente fórmulas complexas, gráficos e qualquer coisa que você tenha usado antes; Criptografar células com senha; Criar lista de discussão e enviar emails ...
  • Super Formula Bar (edite facilmente várias linhas de texto e fórmula); Layout de leitura (ler e editar facilmente um grande número de células); Colar na faixa filtrada...
  • Mesclar células / linhas / colunas sem perder dados; Dividir o conteúdo das células; Combinar linhas / colunas duplicadas... Evite células duplicadas; Comparar intervalos...
  • Selecione Duplicado ou Único Linhas; Selecione linhas em branco (todas as células estão vazias); Super Find e Fuzzy Find em muitos livros; Seleção aleatória ...
  • Cópia exata Várias células sem alterar a referência da fórmula; Criação automática de referências para várias folhas; Inserir marcadores, Caixas de seleção e mais ...
  • Extrair Texto, Adicionar texto, remover por posição, Remover Espaço; Criar e imprimir subtotais de paginação; Converter entre conteúdo de células e comentários...
  • Super Filtro (salvar e aplicar esquemas de filtro a outras planilhas); Classificação Avançada por mês / semana / dia, frequência e mais; Filtro Especial por negrito, itálico ...
  • Combine pastas de trabalho e planilhas; Mesclar tabelas com base em colunas-chave; Divida os dados em várias folhas; Conversão em lote de xls, xlsx e PDF...
  • Mais de 300 recursos poderosos. Suporta Office / Excel 2007-2019 e 365. Suporta todos os idiomas. Fácil implantação em sua empresa ou organização. Teste gratuito de 30 dias com recursos completos. Garantia de devolução do dinheiro em 60 dias.
guia kte 201905

Guia do Office traz interface com guias para o Office e torna seu trabalho muito mais fácil

  • Habilite a edição e leitura com guias em Word, Excel, PowerPoint, Publisher, Access, Visio e Project.
  • Abra e crie vários documentos em novas guias da mesma janela, em vez de em novas janelas.
  • Aumenta sua produtividade em 50% e reduz centenas de cliques do mouse para você todos os dias!
officetab bottom
</ p >

Say something here...
symbols left.
You are guest
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    Art · 1 years ago
    Dang it, copy/paste bit me. Also, with explicit sheet references the With isn't needed:

    Public Sub AutoFitMergedCells(oRange As Range, ByVal dblWidth As Double)

    oRange.MergeCells = False
    Sheet1.Range("A1") = oRange.Cells(1, 1).Value
    Sheet1.Range("A1").WrapText = True
    Sheet1.Columns(1).ColumnWidth = dblWidth
    Sheet1.Rows(1).EntireRow.AutoFit
    oRange.Parent.Rows(oRange.Row).Resize(oRange.Rows.Count).RowHeight _
    = Sheet1.Rows(1).RowHeight / oRange.Rows.Count
    oRange.MergeCells = True
    oRange.WrapText = True

    End Sub
  • To post as a guest, your comment is unpublished.
    Art · 1 years ago
    Thank you, that helped me with a sheet I've not been happy with for years.

    I did change things around a bit, my merged cells are all in one column so I calculated that outside the loop and passed it. I also inserted a Sheet1 that is hidden, and manipulated the columns/rows there so as to not affect the sheet I'm working on. The references should probably be more explicit:

    Public Sub AutoFitMergedCells(oRange As Range, ByVal dblWidth As Double)

    Dim dblHeight As Double

    With oRange.Parent
    oRange.MergeCells = False
    Sheet1.Range("A1") = oRange.Cells(1, 1).Value
    Sheet1.Range("A1").WrapText = True
    Sheet1.Columns(1).ColumnWidth = dblWidth
    Sheet1.Rows(1).EntireRow.AutoFit
    dblHeight = Sheet1.Rows(1).RowHeight / oRange.Rows.Count
    oRange.Parent.Rows(oRange.Row).Resize(oRange.Rows.Count).RowHeight = newHeight
    oRange.MergeCells = True
    oRange.WrapText = True
    Sheet1.Range("A1").ClearContents
    End With

    End Sub
  • To post as a guest, your comment is unpublished.
    José · 2 years ago
    This not work for me}
  • To post as a guest, your comment is unpublished.
    saravanan · 2 years ago
    not working , ye password set in your code not working in your code
  • To post as a guest, your comment is unpublished.
    dougs · 2 years ago
    I believe the reason that the row heights do not calculate properly is related to these lines of code
    For iPtr = 1 To oRange.Columns.Count
    oldWidth = oldWidth + .Cells(1, oRange.Column + iPtr - 1).ColumnWidth
    Next iPtr
    oldWidth = .Cells(1, oRange.Column).ColumnWidth + .Cells(1, oRange.Column + 1).ColumnWidth

    The variable OldWidth gets set to the sum of the column widths in the range, but for some reason it gets reset to only the width of the first two columns. The first 3 lines of code are therefore made redundant by the 4th line. When I removed the line it was much better, but the other issue I found was that you have to make sure that the font and font size of the temporary cell (ZZ1 in the example code) must match the font and size of the merged cells; otherwise, text will not wrap in the same way as the merged cells wrap and may not be the correct height.
  • To post as a guest, your comment is unpublished.
    toowaki · 3 years ago
    I made add-in for Auto fit row height of multiple merged cells.
    Please use this, if you want to autofit row hight.
    [Release Ver2.6 · toowaki/AutoFitRowEx · GitHub]
    https://github.com/toowaki/AutoFitRowEx/releases/tag/2.6.2
    • To post as a guest, your comment is unpublished.
      ABC · 3 years ago
      This is pretty helpful, thanks!
  • To post as a guest, your comment is unpublished.
    Krishna · 3 years ago
    I am trying to understand the necessity of Line 19. You are assigning a value again to OldWidth. Can you please explain?
  • To post as a guest, your comment is unpublished.
    Chris · 4 years ago
    My code will not even run I just get a compile error when I try to call the AutoFitMergedCells - Expected Function or variable?
  • To post as a guest, your comment is unpublished.
    Aperture · 4 years ago
    Because the "helper" cell of ZZ1 is using the first row (column ZZ, row 1), if there is ANYTHING in row 1 taller than the text in the row you want to adjust, your resulting height will be taller than what you want.

    To fix this, I made the helper cell the same column as the first column in the oRange and set the row number to the very last row in Excel. Hope this helps you like it does me. 8)

    [u]My Code:[/u]

    Option Explicit
    Public Sub AutoFitAll()
    Call AutoFitMergedCells(Range("A2:Z2"))

    End Sub
    Public Sub AutoFitMergedCells(oRange As Range)
    Dim tHeight As Integer
    Dim iPtr As Integer
    Dim oldWidth As Single
    Dim oldZZWidth As Single
    Dim newWidth As Single
    Dim newHeight As Single
    With Sheets("Sheet1")
    oldWidth = 0
    For iPtr = 1 To oRange.Columns.Count
    oldWidth = oldWidth + .Cells(1, oRange.Column + iPtr - 1).ColumnWidth
    Next iPtr
    oldWidth = .Cells(1, oRange.Column).ColumnWidth + .Cells(1, oRange.Column + 1).ColumnWidth
    oRange.MergeCells = False
    newWidth = Len(.Cells(oRange.Row, oRange.Column).Value)
    oldZZWidth = .Cells("1048576", oRange.Column).ColumnWidth
    .Cells("1048576", oRange.Column) = Left(.Cells(oRange.Row, oRange.Column).Value, newWidth)
    .Cells("1048576", oRange.Column).WrapText = True
    .Columns(oRange.Column).ColumnWidth = oldWidth
    .Rows("1048576").EntireRow.AutoFit
    newHeight = .Rows("1048576").RowHeight / oRange.Rows.Count
    .Rows(CStr(oRange.Row) & ":" & CStr(oRange.Row + oRange.Rows.Count - 1)).RowHeight = newHeight
    oRange.MergeCells = True
    oRange.WrapText = True
    .Cells("1048576", oRange.Column).ClearContents
    .Cells("1048576", oRange.Column).ColumnWidth = oldZZWidth
    End With
    End Sub
  • To post as a guest, your comment is unpublished.
    Retha · 4 years ago
    Thank you for the code. However, the height of my rows do adjust, but now enough. How can I rectify this?
  • To post as a guest, your comment is unpublished.
    Jeff · 4 years ago
    Thanks for posting this, I'm decent with excel and can usually figure out my adjustments but I can't seem to figure out a fix for an issue I'm having, or if one even exists. I have huge amounts of data in the cells (exceeding the single cell height limit of 409.5). The problem is this VBA runs with that same limitation. So some of my data gets cut off even though the rows are merged and the combined cell height allowance is 819, since the VBA adjusts the cell height based off the single ZZ1 cell. Is there anyway to adjust the code to get it to allow the adjusted cell height to include the available height in the merged rows or am I asking for the impossible? Thanks.
  • To post as a guest, your comment is unpublished.
    Vivi · 4 years ago
    Works perfect, but rows are too high! Can we fix this?
  • To post as a guest, your comment is unpublished.
    Hana · 4 years ago
    Brilliant but exactly the same problem as Danielle, rows are too high now. Please someone help!
  • To post as a guest, your comment is unpublished.
    Susan · 4 years ago
    Thanks so much for the code. Is there any way to make the macro run as soon as you type text in a field and hit enter?
  • To post as a guest, your comment is unpublished.
    Viktor · 4 years ago
    Thanks for the code, pretty much what I needed.

    Two remarks, though:
    1) when I run the macro in the same row as the "helper"cell (ZZ1), autofit (line 26) will mess up, because the whole string is fitted into one narow cell. I recommend adding

    oRange.WrapText = False

    in the beginning (or moving the helper cell somewhere out of the way, if possible).
    2) what's the purpose of line 19? You claculate oldWidth in lines 16-18, but then override the calculation in line 19, using only two columns. When I tried the sub on a three-column-wide merged cells, it worked better when I ignored the line...

    Thanks again
  • To post as a guest, your comment is unpublished.
    Afshin · 5 years ago
    Thanks a lot for the code! I have same problem with this code such as DANIËLLE_01.
  • To post as a guest, your comment is unpublished.
    Daniëlle_01 · 5 years ago
    Thanks a lot for the code! It finally works, but... My row height becomes too height. Is there a solution for?

    Thanks a lot!

    [u]This is my code:[/u]

    Option Explicit
    Public Sub AutoFitAll()
    Call AutoFitMergedCells(Range("b162:i162"))
    Call AutoFitMergedCells(Range("b166:i166"))
    Call AutoFitMergedCells(Range("b168:i168"))
    Call AutoFitMergedCells(Range("b170:i170"))
    Call AutoFitMergedCells(Range("b172:i172"))
    End Sub
    Public Sub AutoFitMergedCells(oRange As Range)
    Dim tHeight As Integer
    Dim iPtr As Integer
    Dim oldWidth As Single
    Dim oldZZWidth As Single
    Dim newWidth As Single
    Dim newHeight As Single
    With Sheets("Rapport")
    oldWidth = 0
    For iPtr = 1 To oRange.Columns.Count
    oldWidth = oldWidth + .Cells(1, oRange.Column + iPtr - 1).ColumnWidth
    Next iPtr
    oldWidth = .Cells(1, oRange.Column).ColumnWidth + .Cells(1, oRange.Column + 1).ColumnWidth
    oRange.MergeCells = False
    newWidth = Len(.Cells(oRange.Row, oRange.Column).Value)
    oldZZWidth = .Range("ZZ1").ColumnWidth
    .Range("ZZ1") = Left(.Cells(oRange.Row, oRange.Column).Value, newWidth)
    .Range("ZZ1").WrapText = True
    .Columns("ZZ").ColumnWidth = oldWidth
    .Rows("1").EntireRow.AutoFit
    newHeight = .Rows("1").RowHeight / oRange.Rows.Count
    .Rows(CStr(oRange.Row) & ":" & CStr(oRange.Row + oRange.Rows.Count - 1)).RowHeight = newHeight
    oRange.MergeCells = True
    oRange.WrapText = True
    .Range("ZZ1").ClearContents
    .Range("ZZ1").ColumnWidth = oldZZWidth
    End With
    End Sub
    • To post as a guest, your comment is unpublished.
      Aperture · 4 years ago
      Because the "helper" cell of ZZ1 is using the first row (column ZZ, row 1), if there is ANYTHING in row 1 taller than the text in the row you want to adjust, your resulting height will be taller than what you want.

      To fix this, I made the helper cell the same column as the first column in the oRange and set the row number to the very last row in Excel. Hope this helps you like it does me. 8)

      [u]My Code:[/u]

      Option Explicit
      Public Sub AutoFitAll()
      Call AutoFitMergedCells(Range("A2:Z2"))

      End Sub
      Public Sub AutoFitMergedCells(oRange As Range)
      Dim tHeight As Integer
      Dim iPtr As Integer
      Dim oldWidth As Single
      Dim oldZZWidth As Single
      Dim newWidth As Single
      Dim newHeight As Single
      With Sheets("Sheet1")
      oldWidth = 0
      For iPtr = 1 To oRange.Columns.Count
      oldWidth = oldWidth + .Cells(1, oRange.Column + iPtr - 1).ColumnWidth
      Next iPtr
      oldWidth = .Cells(1, oRange.Column).ColumnWidth + .Cells(1, oRange.Column + 1).ColumnWidth
      oRange.MergeCells = False
      newWidth = Len(.Cells(oRange.Row, oRange.Column).Value)
      oldZZWidth = .Cells("1048576", oRange.Column).ColumnWidth
      .Cells("1048576", oRange.Column) = Left(.Cells(oRange.Row, oRange.Column).Value, newWidth)
      .Cells("1048576", oRange.Column).WrapText = True
      .Columns(oRange.Column).ColumnWidth = oldWidth
      .Rows("1048576").EntireRow.AutoFit
      newHeight = .Rows("1048576").RowHeight / oRange.Rows.Count
      .Rows(CStr(oRange.Row) & ":" & CStr(oRange.Row + oRange.Rows.Count - 1)).RowHeight = newHeight
      oRange.MergeCells = True
      oRange.WrapText = True
      .Cells("1048576", oRange.Column).ClearContents
      .Cells("1048576", oRange.Column).ColumnWidth = oldZZWidth
      End With
      End Sub
    • To post as a guest, your comment is unpublished.
      Viktor · 4 years ago
      Hi Danielle,

      I ran into the same problem, when running the macro a second time in the first row. The code uses

      .Rows("1").EntireRow.AutoFit (line 26)

      and if you run in on, say A1:B1, your A1 cell has WordWrapping set to ON from line 30.

      The easiest solution seems to be switching WordWrapping off at the beginning of the sub. Add

      oRange.WrapText = True

      between lines 13 and 14 and you should be OK.
  • To post as a guest, your comment is unpublished.
    Dina · 5 years ago
    I have the following entered, but I get an error message "Run-time error '13': Type mismatch" Help?


    Option Explicit
    Public Sub AutoFitAll()
    Call AutoFitMergedCells(Range("a8:h8"))
    Call AutoFitMergedCells(Range("a10:h10"))
    Call AutoFitMergedCells(Range("a11:h11"))
    Call AutoFitMergedCells(Range("b17:h17"))
    Call AutoFitMergedCells(Range("b22:h22"))
    Call AutoFitMergedCells(Range("b24:h24"))
    Call AutoFitMergedCells(Range("a26:h26"))
    Call AutoFitMergedCells(Range("a28:h28"))

    End Sub
    Public Sub AutoFitMergedCells(oRange As Range)
    Dim tHeight As Integer
    Dim iPtr As Integer
    Dim oldWidth As Single
    Dim oldZZWidth As Single
    Dim newWidth As Single
    Dim newHeight As Single
    With Sheets("Offer Letter")
    oldWidth = 0
    For iPtr = 1 To oRange.Columns.Count
    oldWidth = oldWidth + .Cells(1, oRange.Column + iPtr - 1).ColumnWidth
    Next iPtr
    oldWidth = .Cells(1, oRange.Column).ColumnWidth + .Cells(1, oRange.Column + 1).ColumnWidth
    oRange.MergeCells = False
    newWidth = Len(.Cells(oRange.Row, oRange.Column).Value)
    oldZZWidth = .Range("ZZ1").ColumnWidth
    .Range("ZZ1") = Left(.Cells(oRange.Row, oRange.Column).Value, newWidth)
    .Range("ZZ1").WrapText = True
    .Columns("ZZ").ColumnWidth = oldWidth
    .Rows("1").EntireRow.AutoFit
    newHeight = .Rows("1").rowHeight / oRange.Rows.Count
    .Rows(CStr(oRange.Row) & ":" & CStr(oRange.Row + oRange.Rows.Count - 1)).rowHeight = newHeight
    oRange.MergeCells = True
    oRange.WrapText = True
    .Range("ZZ1").ClearContents
    .Range("ZZ1").ColumnWidth = oldZZWidth
    End With
    End Sub
  • To post as a guest, your comment is unpublished.
    Joe Dell · 5 years ago
    This code causes additional rows to be deleted. I have numbers on left side and columns next to it are merged/wrapped data. For example, in a Job description, list responsibilities with numbers followed by explanation of duty. Any thoughts? Thanks.