Using “If cell contains” in VBA excel

后端 未结 6 2395
孤独总比滥情好
孤独总比滥情好 2020-12-10 16:55

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:

相关标签:
6条回答
  • 2020-12-10 17:37

    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
    
    0 讨论(0)
  • 2020-12-10 17:38
    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.

    0 讨论(0)
  • 2020-12-10 17:42

    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
    
    0 讨论(0)
  • 2020-12-10 17:49

    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
    

    0 讨论(0)
  • 2020-12-10 17:54

    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.

    0 讨论(0)
  • 2020-12-10 17:59
    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.

    0 讨论(0)
提交回复
热议问题