Question

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

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

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

我有一个代码，将使用VBA对excel中的单元格进行Unmerged，Sort和Remerge，但它无法对Rows进行排序，因为我有2个范围。第一个范围是＆＃34; A10：AA350＆＃34;用于未聚合和填充共聚电池，第二范围是＆＃34; A10：DZ350＆＃34;用于分类。

'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

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

1 个答案: