Excel VBA: Searching einen Text und machen es fett und Wechselzelle Farbe

stimmen
0

Neu bei all dem aber jede Hilfe dankbar ich bekommen kann.

Problem: Ich habe einen Dienstplan mit Initialen und manchmal mag ich eine bestimmte Person markieren ihren / seinen Zeitplan zu sehen. Das Highlight besteht die Schriftfarbe zu ändern und machen es fett, aber ich möchte auch die Zellenfarbe auch ändern, lässt das Licht grün sagen. Ich weiß, dass ich die Suche verwenden können / Ersetzen-Funktion, aber ich würde ein Makro für diese mögen.

Bisher habe ich es geschafft, ein Eingabefeld um Stück zusammen und ich kann die Schriftfarbe ändern und hinzufügen ‚fett‘ an die Schrift (und andere Änderungen), aber ich habe nicht die Änderung der Zellenfarbe gelöst.

Das ist, was ich habe, so weit:

Sub FindAndBold()
Dim sFind As String
Dim rCell As Range
Dim rng As Range
Dim lCount As Long
Dim iLen As Integer
Dim iFind As Integer
Dim iStart As Integer

On Error Resume Next
Set rng = ActiveSheet.UsedRange. _
  SpecialCells(xlCellTypeConstants, xlTextValues)
On Error GoTo ErrHandler
If rng Is Nothing Then
    MsgBox There are no cells with text
    GoTo ExitHandler
End If

sFind = InputBox( _
  Prompt:=Skriv in dina initialer, _
  Title:=Dina initialer)
If sFind =  Then
    MsgBox Du skrev inget
    GoTo ExitHandler
End If

iLen = Len(sFind)
lCount = 0

For Each rCell In rng
    With rCell
        iFind = InStr(.Value, sFind)
        Do While iFind > 0
            .Characters(iFind, iLen).Font.Bold = True
            .Characters(iFind, iLen).Font.Color = RGB(255, 0, 0)
            .Characters(iFind, iLen).Font.ColorIndex = 4
            lCount = lCount + 1
            iStart = iFind + iLen
            iFind = InStr(iStart, .Value, sFind)
        Loop
    End With
Next

If lCount = 0 Then
    MsgBox Fanns inget & _
      vbCrLf & '  & sFind &  ' & _
      vbCrLf & att markera
ElseIf lCount = 1 Then
    MsgBox Det fanns en & _
      vbCrLf & '  & sFind &  ' & _
      vbCrLf & markerades
Else
    MsgBox lCount &  hittade & _
      vbCrLf & '  & sFind &  ' & _
      vbCrLf & och markerades
End If

ExitHandler:
Set rCell = Nothing
Set rng = Nothing
Exit Sub

ErrHandler:
MsgBox Err.Description
Resume ExitHandler

Jede Hilfe wäre sehr dankbar! (Der Text in der Aufforderung und Antwort ist in Swedish)

Veröffentlicht am 20/10/2018 um 12:30
quelle vom benutzer
In anderen Sprachen...                            


1 antworten

stimmen
0

Sie können auch diese mit der bedingten Formatierung tun, keine Notwendigkeit für VBS.
Ein bedingtes Format Formel verwenden , können Sie so etwas wie dies eingeben: =AND(ISNUMBER(SEARCH($G$1;A2));$G$1<>"")-: alle Felder mit diesem Zustand in diesem Fall Feld G1 würde das Feld für die Suche (Hervorhebung lesen) verwendet werden.

Wenn Sie ein VBS wünschen können wir einen Filter für alle Linien für Ihre Suche verbessern und beinhalten:

Sub searchfilter()
    Range("A11:M10000").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Range("A2:M13"), Unique:=False
End Sub

Und klar:

Sub clearfilter()
    On Error Resume Next
    ActiveSheet.ShowAllData
    On Error GoTo 0
End Sub

Ordnen Sie die beiden Makros zu einer Schaltfläche.

Beispiel-Bild, wo ich beide kombiniert (Filter wurde auf C15 in diesem Fall geschehen): Verwendungsbeispiel

Und gezeigt mit versteckten Feldern probieren: Probe mit versteckten Feldern

Beantwortet am 20/10/2018 um 16:15
quelle vom benutzer

Cookies help us deliver our services. By using our services, you agree to our use of cookies. Learn more