Ինչպե՞ս ավտոմատ կերպով տեղավորել Excel- ում միավորված բջիջների տողի բարձրությունը:
Excel- ում մենք կարող ենք արագորեն շարքի բարձրությունը հարմարեցնել բջիջների պարունակությանը համապատասխան ՝ օգտագործելով AutoFit շարքի բարձրությունը առանձնահատկությունը, բայց այս գործառույթը լիովին անտեսում է միավորված բջիջները: Այսինքն, դուք չեք կարող կիրառել այն AutoFit շարքի բարձրությունը միաձուլված բջիջների տողի բարձրությունը չափափոխելու առանձնահատկություն, անհրաժեշտ է ձեռքով մեկ առ մեկ կարգավորել միաձուլված բջիջների տողի բարձրությունը: Այս հոդվածում ես կարող եմ ներկայացնել այս խնդրի լուծման մի քանի արագ մեթոդներ:
Ենթադրելով, որ ես ունեմ մի թերթ մի քանի միաձուլված բջիջների հետ, ինչպես ցույց է տրված հետևյալ նկարը, և այժմ ես պետք է չափափոխեմ բջիջների շարքի բարձրությունը ՝ ամբողջ բովանդակությունը ցուցադրելու համար, ներքևի VBA կոդը կարող է օգնել ձեզ ավտոմատ կերպով տեղավորել բազմակի միավորված բջիջների տողի բարձրությունը, խնդրում եմ արեք Ինչպես նշված է հետեւյալում:
1, Պահեք պահեք ALT + F11 ստեղները, և այն բացում է Microsoft Visual Basic հավելվածների համար պատուհան.
2: Սեղմեք Տեղադրել > Մոդուլներ, և տեղադրեք հետևյալ կոդը Մոդուլի պատուհան.
VBA կոդ. Բազմաթիվ միավորված բջիջների տողի բարձրության ավտոմատ տեղավորում
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
Նշումներ:
(1.) Վերոնշյալ ծածկագրում կարող եք ավելացնել նոր միջակայքեր, որոնք պարզապես պատճենելու են Callանգահարել AutoFitMergedCells (Range ("a1: b2")) գրեք շատ անգամ, որքան ցանկանում եք, և փոխեք բջիջների միաձուլված միջակայքերը ՝ ըստ ձեզ անհրաժեշտի:
(2.) Եվ դուք պետք է փոխեք ընթացիկ աշխատանքային թերթի անունը Sheet4 ձեր օգտագործված թերթիկի անվան վրա:
3, Դրանից հետո սեղմեք F5 այս կոդն աշխատեցնելու բանալին, և այժմ դուք կտեսնեք, որ բոլոր միավորված բջիջները ավտոմատ կերպով տեղադրվել են իրենց բջիջների բովանդակության վրա:
Լրացրեք ձեր Excel-ի հմտությունները Kutools-ի հետ Excel-ի համար և փորձեք արդյունավետությունը, ինչպես երբեք: Kutools-ը Excel-ի համար առաջարկում է ավելի քան 300 առաջադեմ առանձնահատկություններ՝ արտադրողականությունը բարձրացնելու և ժամանակ խնայելու համար: Սեղմեք այստեղ՝ Ձեզ ամենաշատ անհրաժեշտ հատկանիշը ստանալու համար...
Լրացրեք ձեր Excel-ի հմտությունները Kutools-ի հետ Excel-ի համար և փորձեք արդյունավետությունը, ինչպես երբեք: Kutools-ը Excel-ի համար առաջարկում է ավելի քան 300 առաջադեմ առանձնահատկություններ՝ արտադրողականությունը բարձրացնելու և ժամանակ խնայելու համար: Սեղմեք այստեղ՝ Ձեզ ամենաշատ անհրաժեշտ հատկանիշը ստանալու համար...
This comment was minimized by the moderator on the site
Hi All,
I modify the codes, which will search the merged cells and apply the autofit. hope this will help the future if any one interested.
Sub FindMergedCells()
' Declare sheet you want to look for merged cells on - in the example it's sheet 1
Dim sheet As Worksheet
Set sheet = ActiveWorkbook.Sheets(1)
Dim rng As Range
Dim rngStart As Range
Dim rngEnd As Range
Dim tHeight As Integer
Dim iPtr As Integer
Dim oldWidth As Double
Dim oldZZWidth As Double
Dim newWidth As Double
Dim newHeight As Double
Dim oRange As Range
' Add sheet for output
Dim output As Worksheet
Set output = Sheets.Add(after:=Sheets(1))
' Initialize row counter for output
orow = 0
' Header on output sheet
' Check all the cells in the worksheet's used range
For Each cell In sheet.UsedRange
' If they're merged -
If cell.MergeCells Then
orow = orow + 1
Set cell = cell.MergeArea
Set rngStart = cell.Cells(1, 1)
Set rngEnd = cell.Cells(cell.Rows.Count, cell.Columns.Count)
This comment was minimized by the moderator on the site
I have tried this as I am not at all proficient with VBA. At the "Set Sheet = Activeworkbook I always get this Compile Error - Invalid outside procedure. What am I doing wrong?
This comment was minimized by the moderator on the site
There is a limit on the size - if the total height required is greater than 409.5, it will only do what would fit in 409.5 and spread it amongst the height of the merged cells and you would not see the remainder. I was hoping this would solve for text lengths greater than the max row height (409.5). I think you may need to iterate through and split the text to what can fit in to the first max height of 409.5 then put the rest in another cell (ZZ2) and so on until it fits, then count the rows in each cell then get the total required height.
This comment was minimized by the moderator on the site
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)
This comment was minimized by the moderator on the site
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.
VBA կոդով միավորված բջիջների շարքի ավտոմատ տեղավորում
