Excel VBA根据查找值更改行高

Question

我有一个有 2 张纸的工作簿。第一个有 2 列数据。第二个是格式化的时间表。我想在计划中的第一列数据中找到值：

代入第二列的数据 将具有新值的单元格的行高增加 5。 将 Schedule 中所有单元格的字体更改为 Calibri。

这是我目前所拥有的，但它不起作用：

Public Sub FindReplace()
    Dim AllCells As Range
    Dim myList As Range
    Dim myRange As Range
    Dim myHeight As Double

    Set AllCells = Sheets("Sheet 1").Cells
    AllCells.Font.Name = "Calibri"

    Set myList = Sheets("FindReplace").Range("A1:C200")
    Set myRange = Sheets("Sheet 1").Cells

    For Each cel In myList.Columns(1).Cells
        myRange.Select
        Selection.Find(What:=cel.Value, LookIn:=xlFormulas, LookAt:=xlWhole).Activate
        ActiveCell.RowHeight = myHeight
        myHeight = myHeight + 5
        Selection.RowHeight = myHeight

        myRange.Replace cel.Value, cel.Offset(0, 2), LookAt:=xlWhole     
    Next cel
End Sub

请帮忙

Answer 1

试试这个：

Option Explicit

Public Sub FindReplace()

Dim myList, myRange, CelA, celB As Range

Set myRange = Sheets("T3").Cells
myRange.Font.Name = "Calibri"
Set myList = Sheets("T2").Range("A1:c200")
For Each CelA In myList.Columns(1).Cells
    If CelA <> "" Then
        Set celB = myRange.Cells.Find(What:=CelA.Value, LookIn:=xlFormulas, LookAt:=xlWhole)
        If Not celB Is Nothing Then
            If celB.RowHeight < 410 Then celB.RowHeight = celB.RowHeight + 5
            myRange.Replace CelA.Value, CelA.Offset(0, 2), LookAt:=xlWhole
        End If
    End If
Next CelA
End Sub

Answer 2

这样的事情可能会奏效：

Option Explicit

Public Sub FindReplace()

    Dim AllCells        As Range
    Dim myList          As Range
    Dim myRange         As Range
    Dim myHeight        As Double
    Dim cel             'not declared in your code, but its a good idea to do it

    Set AllCells = Sheets("T3").Cells
    AllCells.Font.Name = "Calibri"

    Set myList = Sheets("T2").Range("A1:C200")
    Set myRange = Sheets("T3").Cells

    For Each cel In myList.Columns(1).Cells
        myRange.Parent.Activate
        myRange.Select
        'Selection.Find(What:=cel.Value, LookIn:=xlFormulas, LookAt:=xlWhole).Activate

        myHeight = myHeight + 5

        If myHeight < 410 Then
            'Selection.RowHeight = myHeight
            ActiveCell.RowHeight = myHeight
        End If
        myRange.Replace cel.Value, cel.Offset(0, 2), LookAt:=xlWhole
    Next cel
End Sub

改变了什么？

• 工作表的名称。
• cel 元素的活动工作表使用myRange.Parent.Activate 激活
• 引入了 410 高度的条件。
• 顶部显式选项

一般来说，代码质量不高，因为它使用了Select 和Activate，出于性能和调试原因，这违反了最佳实践。