使用 vba 在 Excel 中设置单元格的宽度和高度

Question

我在 Excel-VBA 中有一个项目，用于复制行并将其粘贴到新工作表中，其中，它将使用 1 列自动按日期对行进行排序。但是，将这些行粘贴到另一张纸上后，单元格高度很薄，我不知道这是怎么回事，有人可以帮我根据另一个单元格的高度设置它的高度吗？

我这里有一个设置高度的代码，但它不起作用。

Rows("3:25").RowHeight = 25

我有一个代码可以使用 VBA 取消合并、排序和重新合并 Excel 中的单元格，但它无法对行进行排序，因为我有 2 个范围。第一个范围是“A10：AA350”，用于取消合并和填充共同单元格，第二个范围是“A10：DZ350”，用于排序。

'Unmerged, Sorting, and Remerging of Cells and Rows
Sub Sort()
Dim myRange As Range
Dim lstrow As Long
Dim l As Long
Dim rng As Range
Dim address As String
Dim contents As Variant
Dim ws As Worksheet
Dim rngNew As Range
On Error GoTo myErr

Application.ScreenUpdating = False

Set ws = ThisWorkbook.Sheets("SAMPLE")

Set myRange = ws.Range("A5:AA350")

Set rngNew = ws.Range("A5:DZ350")
' Get lstrow from Column N, if Column A has merged cells
lstrow = ws.Cells(Rows.Count, 14).End(xlUp).Row

' Unmerge and populate
For Each rng In myRange
    If rng.MergeCells Then
        ' Get value from top left cell
        contents = rng.MergeArea.Cells(1).Value
        address = rng.MergeArea.address
        rng.UnMerge
        ws.Range(address).Value = contents
    End If
Next rng

' Sort
rngNew.Sort key1:=ws.Range("Q5:Q" & lstrow), _
    order1:=xlAscending, Header:=xlNo

' Turn off alerts
Application.DisplayAlerts = False

' Re-merge
With ws
    For l = 5 To lstrow


        If .Cells(l, 10).MergeArea.Cells(1).Value = .Cells(l + 1, 10).MergeArea.Cells(1).Value _
            And .Cells(l, 17).MergeArea.Cells(1).Value = .Cells(l + 1, 17).MergeArea.Cells(1).Value _
            And .Cells(l, 18).MergeArea.Cells(1).Value = .Cells(l + 1, 18).MergeArea.Cells(1).Value _
            And .Cells(l, 19).MergeArea.Cells(1).Value = .Cells(l + 1, 19).MergeArea.Cells(1).Value _
            And .Cells(l, 20).MergeArea.Cells(1).Value = .Cells(l + 1, 20).MergeArea.Cells(1).Value _
            And .Cells(l, 21).MergeArea.Cells(1).Value = .Cells(l + 1, 21).MergeArea.Cells(1).Value _
            And .Cells(l, 22).MergeArea.Cells(1).Value = .Cells(l + 1, 22).MergeArea.Cells(1).Value _
            And .Cells(l, 23).MergeArea.Cells(1).Value = .Cells(l + 1, 23).MergeArea.Cells(1).Value _
            And .Cells(l, 24).MergeArea.Cells(1).Value = .Cells(l + 1, 24).MergeArea.Cells(1).Value _
            And .Cells(l, 25).MergeArea.Cells(1).Value = .Cells(l + 1, 25).MergeArea.Cells(1).Value _
            And .Cells(l, 26).MergeArea.Cells(1).Value = .Cells(l + 1, 26).MergeArea.Cells(1).Value _
            And .Cells(l, 27).MergeArea.Cells(1).Value = .Cells(l + 1, 27).MergeArea.Cells(1).Value _
            Then

            ' Merge column A
            Range(.Cells(l, 10).MergeArea, .Cells(l + 1, 10)).Merge

            ' Merge column C
            Range(.Cells(l, 17).MergeArea, .Cells(l + 1, 17)).Merge


             Range(.Cells(l, 18).MergeArea, .Cells(l + 1, 18)).Merge

              Range(.Cells(l, 19).MergeArea, .Cells(l + 1, 19)).Merge

               Range(.Cells(l, 20).MergeArea, .Cells(l + 1, 20)).Merge

                Range(.Cells(l, 21).MergeArea, .Cells(l + 1, 21)).Merge

                 Range(.Cells(l, 22).MergeArea, .Cells(l + 1, 22)).Merge

                  Range(.Cells(l, 23).MergeArea, .Cells(l + 1, 23)).Merge

                   Range(.Cells(l, 24).MergeArea, .Cells(l + 1, 24)).Merge

                    Range(.Cells(l, 25).MergeArea, .Cells(l + 1, 25)).Merge

                     Range(.Cells(l, 26).MergeArea, .Cells(l + 1, 26)).Merge

                      Range(.Cells(l, 27).MergeArea, .Cells(l + 1, 27)).Merge


        End If
    Next l
 End With

' Turn on alerts
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Exit Sub

myErr:
    MsgBox "Unable to sort!"
End Sub

有人可以帮我解决这个问题吗？

Answer 1

对初始问题的修复

---

您需要告诉 Excel 工作表的名称，例如：

ThisWorkbook.Worksheets("Sheet1").Rows("3:25").RowHeight = 25