从定义的范围转换excel宏，只对选定的单元格进行操作？

Question

我有一个宏可以做我想做的事，但它在一组单元格上运行。我一直试图让它只在用户选择（突出显示）的单元格上运行。我尝试了使用 Dim Rng 作为 Range 以及 Selection 方法来定义范围的各种组合。我：没有VBA经验可言，一些python经验。

工作代码（定义范围）

Sub NoHalve()
'
' Macro to remove less-than sign and report only the LOR formatted grey and underlined .
' x = columns, y = rows
    For x = 1 To 200
        For y = 2 To 3000
            If Left(Cells(y, x), 1) = "<" Then
            Cells(y, x) = (Right(Cells(y, x), Len(Cells(y, x)) - 1))
            Cells(y, x).Select
            Selection.Font.ColorIndex = 16
            Selection.Font.Underline = xlUnderlineStyleSingle
            End If
        Next y
    Next x

End Sub

这是我尝试让它在用户选择的单元格上运行，这给了我 r.Select 行的对象所需的错误：

Sub NoHalve_selection()

Set Rng = Selection

For Each r In Rng

    If Left(r, 1) = "<" Then
    r = (Right(r, Len(r) - 1))
    r.Select
    Selection.Font.ColorIndex = 16
    Selection.Font.Underline = xlUnderlineStyleSingle
    End If
Next
End Sub

Answer 1

你快到了

Sub NoHalve_selection()
    Dim r As Range, Rng As Range
    Set Rng = Selection

    For Each r In Rng.Cells ' .Cells is implied in For Each r in Rng
        With r  'Using With block is more efficient as it does fewer lookups to Excel
            If Left$(.Value, 1) = "<" Then  ' .Value uses the With block (so is the same as r.Value).  Value is the default property of a Range 
                .Value = Mid$(.Value, 2)
                .Font.ColorIndex = 16
                .Font.Underline = xlUnderlineStyleSingle
            End If
        End With
   Next
End Sub

原帖对比

Sub NoHalve_selection()
    Dim r As Range, Rng As Range
    Set Rng = Selection

    For Each r In Rng
        If Left(r, 1) = "<" Then
            r = (Right(r, Len(r) - 1))
            r.Font.ColorIndex = 16
            r.Font.Underline = xlUnderlineStyleSingle
        End If
   Next
End Sub

Answer 2

通过将硬编码数字替换为Selection.Columns.Count 和Selection.Rows.Count，这应该相对容易。

Sub NoHalve()
'
' Macro to remove less-than sign and report only the LOR formatted grey and underlined .
' x = columns, y = rows
    For x = 1 To Selection.Columns.Count
        For y = 2 To Selection.Rows.Count
            If Left(Cells(y, x), 1) = "<" Then
            Cells(y, x) = (Right(Cells(y, x), Len(Cells(y, x)) - 1))
            Cells(y, x).Font.ColorIndex = 16
            Cells(y, x).Font.Underline = xlUnderlineStyleSingle
            End If
        Next y
    Next x
End Sub

如果您要进行简单的文本替换（删除符号），只要该符号在最左边，那么我还建议您使用不太依赖字符串中字符位置的东西.所以像replace:

Cells(y, x) = replace(Cells(y, x),"<","",,1)

另外我不认为Cells(y, x).Select 行是必需的，并且可能会不必要地更改活动选择。