在 VBA excel 中使用“如果单元格包含”

Question

我正在尝试编写一个宏，如果有一个带有单词“TOTAL”的单元格，那么它将在其下方的单元格中输入一个破折号。例如：

在上面的例子中，我希望在单元格 F7 中有一个破折号（注意：可以有任意数量的列，所以它总是第 7 行，但不总是 F 列）。

我目前正在使用此代码，但它不起作用，我不知道为什么。

Dim celltxt As String
Range("C6").Select
Selection.End(xlToRight).Select
celltxt = Selection.Text
If InStr(1, celltext, "TOTAL") > 0 Then
Range("C7").Select
Selection.End(xlToRight).Select
Selection.Value = "-"
End If

我们将不胜感激。希望我没有做傻事。

Answer 1

这将遍历您定义("RANGE TO SEARCH") 的给定范围内的所有单元格，并使用Offset() 方法在下面的单元格中添加破折号。作为 VBA 的最佳实践，您永远不应该使用 Select 方法。

Sub AddDashes()

Dim SrchRng As Range, cel As Range

Set SrchRng = Range("RANGE TO SEARCH")

For Each cel In SrchRng
    If InStr(1, cel.Value, "TOTAL") > 0 Then
        cel.Offset(1, 0).Value = "-"
    End If
Next cel

End Sub

Answer 2

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

If Not Intersect(Target, Range("C6:ZZ6")) Is Nothing Then

    If InStr(UCase(Target.Value), "TOTAL") > 0 Then
        Target.Offset(1, 0) = "-"
    End If

End If

End Sub

这将允许您动态添加列并自动在 C 行中的任何列下方插入一个破折号，在 6 之后包含不区分大小写的“总计”。注意：如果您超过 ZZ6，则需要更改代码，但这应该可以让您到达您需要去的地方。

Answer 3

这也是一样的，用 CONTAINS 增强：

Function SingleCellExtract(LookupValue As String, LookupRange As Range, ColumnNumber As Integer, Char As String)
Dim I As Long
Dim xRet As String
For I = 1 To LookupRange.Columns(1).Cells.Count
     If InStr(1, LookupRange.Cells(I, 1), LookupValue) > 0 Then
        If xRet = "" Then
            xRet = LookupRange.Cells(I, ColumnNumber) & Char
        Else
            xRet = xRet & "" & LookupRange.Cells(I, ColumnNumber) & Char
        End If
    End If
Next
SingleCellExtract = Left(xRet, Len(xRet) - 1)
End Function

Answer 4

Dim celltxt As String
Range("C6").Select
Selection.End(xlToRight).Select
celltxt = Selection.Text
If InStr(1, celltext, "TOTAL") > 0 Then
Range("C7").Select 
Selection.End(xlToRight).Select
Selection.Value = "-"
End If

您在指令中声明了“celltxt”并使用了“celltext”。

Answer 5

这是你要找的吗？

 If ActiveCell.Value == "Total" Then

    ActiveCell.offset(1,0).Value = "-"

 End If

你可以做这样的事情

 Dim celltxt As String
 celltxt = ActiveSheet.Range("C6").Text
 If InStr(1, celltxt, "Total") Then
    ActiveCell.offset(1,0).Value = "-"
 End If

这与您所拥有的相似。

Answer 6

要求：
找到包含单词TOTAL 的单元格，然后在其下方的单元格中输入破折号。

解决方案： 此解决方案使用Range 对象的Find 方法，因为使用它而不是蛮力（For…Next 循环）似乎合适。 该方法的解释和详细信息见Range.Find method (Excel)

实施：
为了提供灵活性，Find 方法被包装在这个函数中：

Function Range_ƒFind_Action(sWhat As String, rTrg As Range) As Boolean

其中：
sWhat：包含要搜索的string
rTrg：是要搜索的range

如果找到任何匹配，该函数返回True，否则返回False

此外，每次函数找到匹配项时，它都会将生成的range 传递给过程Range_Find_Action 以执行所需的操作，（即“在其下方的单元格中输入破折号” )。 “必需的操作”位于一个单独的过程中，以允许自定义和灵活性。

这是函数的调用方式：

此测试正在搜索“total”以显示MatchCase:=False 的效果。通过将匹配更改为MatchCase:=True

，可以使匹配区分大小写

Sub Range_Find_Action_TEST()
Dim sWhat As String, rTrg As Range
Dim sMsgbdy As String
    sWhat = "total"                                             'String to search for (update as required)
    Rem Set rTrg = ThisWorkbook.Worksheets("Sht(0)").UsedRange  'Range to Search (use this to search all used cells)
    Set rTrg = ThisWorkbook.Worksheets("Sht(0)").Rows(6)        'Range to Search (update as required)
    sMsgbdy = IIf(Range_ƒFind_Action(sWhat, rTrg), _
        "Cells found were updated successfully", _
        "No cells were found.")
    MsgBox sMsgbdy, vbInformation, "Range_ƒFind_Action"
    End Sub

这是查找功能

Function Range_ƒFind_Action(sWhat As String, rTrg As Range) As Boolean
Dim rCll As Range, s1st As String
    With rTrg

        Rem Set First Cell Found
        Set rCll = .Find(What:=sWhat, After:=.Cells(1), _
            LookIn:=xlFormulas, LookAt:=xlPart, _
            SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)

        Rem Validate First Cell
        If rCll Is Nothing Then Exit Function
        s1st = rCll.Address

        Rem Perform Action
        Call Range_Find_Action(rCll)

        Do
            Rem Find Other Cells
            Set rCll = .FindNext(After:=rCll)
            Rem Validate Cell vs 1st Cell
            If rCll.Address <> s1st Then Call Range_Find_Action(rCll)

        Loop Until rCll.Address = s1st

    End With

    Rem Set Results
    Range_ƒFind_Action = True

    End Function

这是动作过程

Sub Range_Find_Action(rCll)
    rCll.Offset(1).Value2 = Chr(167)    'Update as required - Using `§` instead of "-" for visibilty purposes
    End Sub