Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
940to944
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
940to944
940to944
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Makro nur auf vorher markierte Zellen anwenden

Makro nur auf vorher markierte Zellen anwenden
15.01.2008 16:50:00
Weber
Zunächst mal: Ich bin immer wieder froh, wenn ich in dem Forum eine Lösung für mein Problem finde. Ich finde das ganz toll.
Nun habe ich folgendes Problem: Es soll eine Plausibilitätsprüfung (von verschiedenen Zahlen) in einem Excel-Tabellenblatt durchgeführt werden. Die Formel für die Plausibiltätsprüfung ist bekannt. Allerdings soll die Plausibilitätsprüfung nur auf den vorher markierten Zellenbereich angewendet werden. Die Markierung des Zellbereichs ist jedesmal an einer anderen Stelle und unterschiedlich groß. Kann man das so programmieren? Wer kann mir weiterhelfen?
Vielen Dank im Voraus.

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro nur auf vorher markierte Zellen anwenden
15.01.2008 17:20:00
Johann
Hallo,
nachfolgend ein Makro, welches - nachdem ein Bereich markiert wurde - gleiche Inhalte mit gleichen Farben einfärbt.
Daraus kannst Du Dir ablesen, wie einfach man auf die selektierten Zellen zugreifen kann.
LG
Johann
'#################################################################
' Einfaerben von Zellen gleichen Inhaltes
' Vor Start dieses Programmes ist ein Zilebereich zu markieren.
' Dies kann ein zusamenhängender Bereich oder mehrere Bereiche sein.
' Danach mit ALT+F8 das Makro starten.
' Dadurch werden alle Zellen mit gleichem Inhalt mit gleicher
' Farbe eingefärbt.
' Autor: J.Kellner - zur freien Verwendung ohne Gewähr

Sub Gleiche_Inhalte_Faerben()
Dim ParLeer As Boolean
Dim WS1 As String
Dim c As Range
Dim VglWert1 As Variant
Dim VglWert2 As Variant
Dim CellCount As Long       'Anzahl der betroffenen Zellen
Dim Abort As Boolean
Const MaxDurchlauf = 100   ' Maximale Durchlauf-Anzahl (wie oft wird versucht Gruppe zu finden)
Dim Durchlauf As Integer   ' Durchlaufzähler
Dim ErstIdx As Long        ' Ab welcher Zellen-Nummer begonnen wird
Dim AktIdx As Long
Dim VglStored As Boolean   ' Indikator ob Vergleichswert bespeichert
Dim AnzMatch As Long       ' Anzahl der gleichen pro Durchlauf
Dim FMRow    As Long       ' Zeilennummer der ersten Zelle der Gruppe
Dim FMCol    As Long       ' Spaltennummer der ersten Zelle der Gruppe
Dim bereich As Range
Const MaxGruppen = 10
Dim GruppenNr As Integer   ' Anzahl der gefundenen Gruppen (und gleichen Farben)
Dim Farbwert(1 To MaxGruppen) As Long   ' Tabelle für Farbwerte
Application.StatusBar = "Zellenvergleich gestartet!"
Farbwert(1) = 6     'Gelb
Farbwert(2) = 44    'Orange
Farbwert(3) = 34    'Hellblau
Farbwert(4) = 39    'Violett
Farbwert(5) = 3     'Rot
Farbwert(6) = 43    'Grün
Farbwert(7) = 38    'Rosa
Farbwert(8) = 41    'Mittelblau
Farbwert(9) = 15    'Grau
Farbwert(10) = 9    'Braun
Abort = False
CellCount = 0               ' Initialisieren des Counters
For Each c In Selection
CellCount = CellCount + 1  ' Inkrementieren
If CellCount > 66000 Then       ' Wenn mehr als x Zellen
WS1 = "Die Anzahl der gewählten Zellen ist zu groß !" & vbCrLf   ' Meldung ausgeben
WS1 = WS1 & "Die Verarbeitung würde zu lange dauern !"
MsgBox WS1, vbOKOnly, "Zu viele Zellen gewählt!"
Abort = True                ' und verweigern die Arbeit
Exit For
End If
If Not IsEmpty(c.Value) Then  ' wir beachten nur befüllte Zellen
c.Interior.ColorIndex = xlNone     ' Farbe zurücksetzen
End If
Next c
If Not Abort Then
Durchlauf = 1
ErstIdx = 0
GruppenNr = 0        ' Initialisieren der Gruppen-Nummer
Do While (Not Abort) And Durchlauf  ErstIdx Then
If Not IsEmpty(c.Value) Then        ' Wenn Zelle wirklich einen Inhalt hat
If c.Interior.ColorIndex = xlNone Then  ' Wenn noch keiner anderen Gruppe angehört
If Not VglStored Then             ' Wenn wir noch keinen Vergleich hatten
VglWert1 = c.Value                ' Inhalt merken
VglStored = True                  ' Indikator setzen
FMRow = c.Row                     ' Zeile Merken
FMCol = c.Column                  ' Spalte merken
ErstIdx = AktIdx          ' nun Index merken für nächsten Durchlauf-Beginn
Else                            ' Wenn schon vergleichswert vorhanden
VglWert2 = c.Value            '    entnehmen des Wertes
If VglWert1 = VglWert2 Then   '   Wenn gleich ist
If AnzMatch = 0 Then        ' Wenn neue Gruppe gefunden wurde
GruppenNr = GruppenNr + 1 ' Anzahl inkrementieren
End If
AnzMatch = AnzMatch + 1
c.Interior.ColorIndex = Farbwert(GruppenNr) ' Farbwert der Zelle setzen
Cells(FMRow, FMCol).Interior.ColorIndex = Farbwert(GruppenNr) ' Farbwert der er
End If
End If
End If
End If
End If
Next c      ' Auf zur nächsten Zelle
If Not VglStored Then   ' wenn ab Erstidx bis Ende kein neuer Wert gefuden wurde
Durchlauf = MaxDurchlauf + 1    ' Abbruch-Indikator setzen
Else
Durchlauf = Durchlauf + 1     ' Durchlauf-Zähler inkrementieren
If GruppenNr >= MaxGruppen Then ' Wenn schon maximale Gruppen-Anzahl gefunden
Durchlauf = MaxDurchlauf + 1    ' Abbruch-Indikator setzen
End If
End If
Loop          ' Weiter zum nächsten Bereichs-Durchlauf
End If
Application.StatusBar = "Zellenvergleich abgeschlossen. Anzahl gefundene Gruppen:" & Str$( _
GruppenNr)
End Sub


Anzeige
AW: Makro nur auf vorher markierte Zellen anwenden
15.01.2008 22:36:38
Luschi
Hallo Johann,
da bei diesem Makro die Anzahl der Schleifendurchläufe doch sehr hoch ist, habe ich mal ein _ neues Makro gemacht, worin der Find-Befehl zum Suchen gleicher Werte benutzt wird:

Sub Gleiche_Inhalte_Faerben_neu()
Dim rg0 As Range, rg1 As Range, rg2 As Range, rg3 As Range
Dim xAdr As String, GruppenNr As Integer, Farbwert(1 To 20)
Farbwert(1) = 6     'Gelb
Farbwert(2) = 44    'Orange
Farbwert(3) = 34    'Hellblau
Farbwert(4) = 39    'Violett
Farbwert(5) = 3     'Rot
Farbwert(6) = 43    'Grün
Farbwert(7) = 38    'Rosa
Farbwert(8) = 41    'Mittelblau
Farbwert(9) = 15    'Grau
Farbwert(10) = 19    'Braun
Farbwert(11) = 16
Farbwert(12) = 48
Farbwert(13) = 31
Farbwert(14) = 37
Farbwert(15) = 13
Farbwert(16) = 22
Farbwert(17) = 36
Farbwert(18) = 56
Farbwert(19) = 24
Farbwert(20) = 8
'alle Tellen in der Markierung
Set rg0 = Application.Selection
rg0.Interior.ColorIndex = xlNone
GruppenNr = 0
'alle Zellen durchlaufen
For Each rg1 In rg0
'wenn Hintergrundfarbe noch nicht gesetzt ist
If (rg1.Interior.ColorIndex = xlNone) Then
'wenn Zelle nicht leer
If Not IsEmpty(rg1.Value) Then
GruppenNr = GruppenNr + 1
'im Zelleverbund rg2 werden alle Zellen gesammelt, die den gleichen Inhalt haben
Set rg2 = rg1
'1. weitere Zelle suchen mit gleichem Zellinhalt
Set rg3 = rg0.Find(rg1.Value, , xlValues, xlWhole, xlByRows, xlNext)
'wenn noch eine Zelle gefunden
If Not rg3 Is Nothing Then
'Zelladresse merken, da der Find-Befehl im Kreis (Endlos-Schleife) sucht
xAdr = rg3.Address
Do
'gefundene Zelle dem Zellverbund rg2 hinzufügen
Set rg2 = Union(rg2, rg3)
'nächste Zelle suchen mit gleichem Inhalt
Set rg3 = rg0.FindNext(rg3)
'Schleifenende, wenn Find-Befehl in Ausgangszelle zurück ist
'ansonsten weitersuchen
Loop While xAdr  rg3.Address
End If
' wenn mehr als eine Zelle im Zellverbund
If rg2.Cells.Count > 1 Then
'Hintergundfarbe setzen
rg2.Interior.ColorIndex = Farbwert(GruppenNr)
End If
End If
End If
Next rg1
'alle Objekte entleeren
Set rg1 = Nothing
Set rg2 = Nothing
Set rg3 = Nothing
Set rg0 = Nothing
'Array-Inhalte löschen
Erase Farbwert()
End Sub

Gruß von Luschi
aus klein-Paris

Anzeige
AW: Makro nur auf vorher markierte Zellen anwenden
16.01.2008 08:16:28
Johann
Finde ich sehr gut:
Wollte jemanden helfen und habe dabei gleich etwas Neues gelernt!
DANKE !
Liebe Grüße aus Wien
PS: Ich hoffe, dass daraus nicht gleich abgeleitet wird, dass die "Ösis" alles so umständlich machen :-)

AW: Makro nur auf vorher markierte Zellen anwenden
16.01.2008 08:05:39
Matthias
Hallo,
vielen Dank für die Hilfe. Es funktioniert.

AW: Makro nur auf vorher markierte Zellen anwenden
16.01.2008 08:06:00
Matthias
Hallo,
vielen Dank für die Hilfe. Es funktioniert.

AW: Makro nur auf vorher markierte Zellen anwenden
15.01.2008 21:51:00
Daniel
Hallo
hier ein Codebeispiel, daß im markierten Zellbereich Formeln und Kostanten unterschiedlich färbt.

Sub Test()
Dim rngBereich As Range
Dim Zelle As Range
Set rngBereich = Selection
For Each Zelle In rngBereich
If Zelle.Formula = "" Then
Zelle.Interior.ColorIndex = xlNone
ElseIf Zelle.HasFormula Then
Zelle.Interior.ColorIndex = 5
Else
Zelle.Interior.ColorIndex = 3
End If
Next
End Sub


Gruß, Daniel

Anzeige
AW: Makro nur auf vorher markierte Zellen anwenden
16.01.2008 08:04:24
Matthias
Hallo,
vielen Dank für die Hilfe. Es funktioniert.

AW: Makro nur auf vorher markierte Zellen anwenden
16.01.2008 10:39:29
Matthias
Nachtrag
Ein Problem taucht nun doch noch auf: Wenn das Makro per Button gestartet wird, dann verschwindet natürlich die Markierung. Wie läßt sich das verhindern?

AW: Makro nur auf vorher markierte Zellen anwenden
16.01.2008 20:37:08
Daniel
Hi
die Selection ist zwar nicht mehr sichtbar, aber immer noch vorhanden, dh. du kannst sie mit SELECTION.SELECT wieder sichtbar machen.
ein anderer Weg wäre, den Code ins allgemeine Modul zu schreiben und per Formularfeld-Button zu starten, dann bleibt die Zellselektion sichtbar erhalten.
Gruß, Daniel

46 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige