Excel VBA: Αναζητώντας ένα κείμενο και να γίνει το χρώμα τολμηρή και αλλαγή των κυττάρων

ψήφοι
0

Νέα για όλα αυτά, αλλά εκτιμούσα οποιαδήποτε βοήθεια μπορώ να πάρω.

Πρόβλημα: Έχω ένα πρόγραμμα υπηρεσίας με τα αρχικά και μερικές φορές θέλω να επισημάνω ένα συγκεκριμένο άτομο για να δείτε το πρόγραμμά του / της. Το αποκορύφωμα αποτελείται από την αλλαγή του χρώματος της γραμματοσειράς και να γίνει τολμηρή, αλλά θα ήθελα επίσης το χρώμα των κυττάρων να αλλάξει, καθώς, σε αφήνει να πει το πράσινο φως. Ξέρω ότι μπορώ να χρησιμοποιήσω την Αναζήτηση / Αντικατάσταση λειτουργία, αλλά θα ήθελα μια μακροεντολή για αυτό.

Μέχρι στιγμής, έχω καταφέρει να συναρμολογήσουν ένα πλαίσιο εισόδου και να αλλάξετε το χρώμα της γραμματοσειράς και να προσθέσετε «τολμηρή» στη γραμματοσειρά (και άλλες αλλαγές), αλλά δεν έχουν λύσει την αλλαγή του χρώματος των κυττάρων.

Αυτό είναι αυτό που έχω μέχρι τώρα:

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

Οποιαδήποτε βοήθεια θα εκτιμηθεί ιδιαίτερα! (Το κείμενο στην άμεση και η ανταπόκριση είναι στα σουηδικά)

Δημοσιεύθηκε 20/10/2018 στις 12:30
πηγή χρήστη
Σε άλλες γλώσσες...                            


1 απαντήσεις

ψήφοι
0

Μπορείτε επίσης να το κάνετε αυτό χρησιμοποιώντας μορφοποίηση υπό όρους, δεν υπάρχει ανάγκη για VBS.
Χρησιμοποιώντας έναν τύπο μορφοποίησης υπό συνθήκη μπορείτε να εισάγετε κάτι σαν αυτό: =AND(ISNUMBER(SEARCH($G$1;A2));$G$1<>"")- σε αυτήν την περίπτωση το πεδίο G1 θα είναι το πεδίο που χρησιμοποιείται για την αναζήτηση (διάβαζε: επισήμανση) όλα τα πεδία που περιέχουν αυτή την κατάσταση.

Αν επιθυμείτε ένα VBS μπορούμε να βελτιώσουμε και να περιλαμβάνει ένα φίλτρο για όλες τις γραμμές που ταιριάζουν στην αναζήτησή σας:

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

Και για να καθαρίσει:

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

Αντιστοιχίστε τις δύο μακροεντολές σε ένα κουμπί.

Sample image όπου i συνδυάζονται αμφότερα (φίλτρο έγινε σε C15 σε αυτήν την περίπτωση): χρήση του δείγματος

Και δοκιμάσετε με κρυμμένα πεδία που εμφανίζονται: δείγματος με κρυφά πεδία

Απαντήθηκε 20/10/2018 στις 16:15
πηγή χρήστη

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