Registriert seit: 06.01.2021
Version(en): Office 365
Liebe Excelfreudne,
leider habe ich im www vergblich nach einem passenden Code gesucht und leider keinen Gefunden.
Da ich diese nur bedingt selber schreiben kann, erhoffe ich proffesionelle Hilfe von euch.
Ich möchte einen Commandbuttun einrichten welche folgfende Funktion erfüllt.
Suche alle Zellwerte aus Matrix F10 bis CH1000, welche die gleichen Wert haben wie Zelle A1 und Formatiere diese z.B. Grün (Zellfarbe).
Ich hoffe ich konnte es gut beschreiben und freue mich auf eure Antworten.
Mfg Marko
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
Hallo Marko,
Code:
Sub Makro1()
With Range("F10:CH1000")
.FormatConditions.Delete
.FormatConditions.Add(Type:=xlExpression, Formula1:="=F10=$A$1").Interior.Color = vbGreen
End With
End Sub
Gruß Uwe
Folgende(r) 1 Nutzer sagt Danke an Kuwer für diesen Beitrag:1 Nutzer sagt Danke an Kuwer für diesen Beitrag 28
• Marko120586
Registriert seit: 06.01.2021
Version(en): Office 365
Superschnell und absolut Perfekt.
Vielen lieben Dank
Registriert seit: 06.01.2021
Version(en): Office 365
Hallo Kuwer,
ich muss leider nochmal was fragen.
Ich würde gerne das, nach dem Markieren, der Suchwert in Zelle A1 löscht wird.
Wenn ich dem Makro den Zusatz " Range("A1").ClearContents anfüge, löscht er zwar den wert, Markiert mir dann aber alle freien Zellen der gewählten Matrix.
Irgendwo fehlt da eine Trennung.
Danke dir für die Hilfe
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
Hallo Marko,
teste es mal damit:
Code:
Sub Makro2()
Dim i As Long, j As Long, k As Long
Dim rngM As Range, rngZ As Range
Dim varA1 As Variant, varM As Variant
Set rngM = Range("F10:CH1000")
varM = rngM.Value
varA1 = Range("A1").Value
For i = 1 To UBound(varM, 1)
For j = 1 To UBound(varM, 2)
If varM(i, j) = varA1 Then
If k Then
Set rngZ = Union(rngZ, rngM.Cells(i, j))
Else
k = 1
Set rngZ = rngM.Cells(i, j)
End If
End If
Next j
Next i
If Not rngZ Is Nothing Then
rngZ.Interior.Color = vbGreen
Else
MsgBox "Keine Einträge gefunden.", vbInformation
End If
End Sub
Gruß Uwe
Registriert seit: 06.01.2021
Version(en): Office 365
Lieber Uwe,
das funktioniert Hervorragend. Ich wünschte ich könnte alles was da steht korrekt interprtieren.
Ich hatte eben noch versucht eben in den gefunden zellen, neben dem farbig markieren, noch eine Notiz hinzuzufügen.
Aber den Code
Code:
Comment.Text Text:="Abgetragen von:" & Chr(10) & Range("A2").Value
bekomme ich leider nicht zum laufen.
Registriert seit: 12.10.2014
Version(en): 365 Insider (32 Bit)
17.01.2023, 08:04
(Dieser Beitrag wurde zuletzt bearbeitet: 17.01.2023, 08:04 von RPP63.)
Moin!
Ganz so einfach ist es ja nicht …
Mache "oben" noch eine zusätzliche Variablendeklaration
Dim Zelle As RangeDann ergänzt Du "unten" wie folgt:
If Not rngZ Is Nothing Then rngZ.Interior.Color = vbGreen For Each Zelle In rngZ If Zelle.Comment Is Nothing Then Zelle.AddComment Zelle.Comment.Text "Abgetragen von:" & Chr(10) & Range("A2").Value End If Next Else MsgBox "Keine Einträge gefunden.", vbInformation End IfGruß Ralf
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag.
Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
Registriert seit: 06.01.2021
Version(en): Office 365
Lieber Uwe und lieber Ralf,
dankenke für eure Unterstützung. Der Code funktioniert wirklich sehr gut.
Es ist echt wundervoll so Professionelle Hilfe zu erhalten.
Tausend Dank nochmal.
Gruß Marko