Using “If cell contains” in VBA excel

问题

I'm trying to write a macro where if there is a cell with the word "TOTAL" then it will input a dash in the cell below it. For example:

In the case above, I would want a dash in cell F7 (note: there could be any number of columns, so it will always be row 7 but not always column F).

I'm currently using this code, but it's not working and I can't figure out why.

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

Help would be appreciated. Hopefully I'm not doing something stupid.

回答1:

This will loop through all cells in a given range that you define ("RANGE TO SEARCH") and add dashes at the cell below using the Offset() method. As a best practice in VBA, you should never use the Select method.

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

回答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

This will allow you to add columns dynamically and automatically insert a dash underneath any columns in the C row after 6 containing case insensitive "Total". Note: If you go past ZZ6, you will need to change the code, but this should get you where you need to go.

回答3:

This does the same, enhanced with 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

回答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

You declared "celltxt" and used "celltext" in the instr.

回答5:

Is this what you are looking for?

 If ActiveCell.Value == "Total" Then

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

 End If

Of you could do something like this

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

Which is similar to what you have.

回答6:

Requirement:
Find a cell containing the word TOTAL then to enter a dash in the cell below it.

Solution: This solution uses the Find method of the Range object, as it seems appropriate to use it rather than brute force (For…Next loop). For explanation and details about the method see Range.Find method (Excel)

Implementation:
In order to provide flexibility the Find method is wrapped in this function:

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

Where:
sWhat: contains the string to search for
rTrg: is the range to be searched

The function returns True if any match is found, otherwise it returns False

Additionally, every time the function finds a match it passes the resulting range to the procedure Range_Find_Action to execute the required action, (i.e. "enter a dash in the cell below it"). The "required action" is in a separated procedure to allow for customization and flexibility.

This is how the function is called:

This test is searching for "total" to show the effect of the MatchCase:=False. The match can be made case sensitive by changing it to 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

This is the Find function

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

This is the Action procedure

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

来源：https://stackoverflow.com/questions/27426835/using-if-cell-contains-in-vba-excel

标签

excel

excel-vba

vba