Anzeige
Archiv - Navigation
816to820
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
816to820
816to820
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

gleiche Werte suchen und Zellen markieren

gleiche Werte suchen und Zellen markieren
07.11.2006 19:09:55
Nico
Hallo Sie,
folgendes möchte ich realsieren:
ausgehend von der aktiven Zelle soll die aktuelle Spalte nach identischen Werten durchsucht werden. Wird ein gleicher Wert gefunden, soll in der jeweiligen Zeile, die Zelle, die acht Spalten weiter rechts steht, blau markiert werden. Folgenden Code hab ich schon, leider klappt da gar nichts. Kann mir jemand helfen ?

Sub gleiche_Werte()
Dim Summe As Variant
Dim Name As Variant
Dim z As Integer
Name = ActiveCell.Value
z = 2
If ActiveCell.Column <> 2 Or ActiveCell.Value = "" Then _
MsgBox ("Wähle zuerst einen Werte aus Spalte B.") _
, vbCritical, "FEHLER" Else
Range("B2").Select
Do Until ActiveCell.Value = ""
If ActiveCell.Value = Name Then
Summe = Summe + ActiveCell.Value
ActiveCell.Offset(0, 8).Select
Selection.Interior.ColorIndex = 37
End If
z = z + 1
Cells(z, 3).Select
Loop
End Sub

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: gleiche Werte suchen und Zellen markieren
07.11.2006 19:56:33
Stefan
Hallo Nico,
Hier Dein Code ein wenig anders. Da ich nicht weiss was Du mit der Summe wolltest, hab ich die weggelassen.

Sub gleiche_Werte()
Dim Summe As Variant
Dim Name As Variant
Dim z As Integer
Name = ActiveCell.Value
z = 2
If ActiveCell.Column <> z Or ActiveCell.Value = "" Then
MsgBox ("Wähle zuerst einen Werte aus Spalte B."), vbCritical, "FEHLER"
Else
Range("B2").Select
Do Until ActiveCell.Value = ""
If ActiveCell.Value = Name Then ActiveCell.Offset(0, 8).Interior.ColorIndex = 37
ActiveCell.Offset(1, 0).Select
Loop
End If
End Sub

Schoene Gruesse
Stefan
Anzeige
AW: gleiche Werte suchen und Zellen markieren
07.11.2006 20:36:14
Nico
Hallo Stefan,
vielen vielen Dank. Sieht schon ganz prima aus. Nun wollte ich noch den markierten Wert in die Variable Summe schreiben, und am Ende des Durchlaufs, das Ergebnis von "Summe=Summe+ActiveCell.Value" in eine Zelle schreiben ... kannst Du mir damit auch noch helfen ?
Vielen Dank
Nico
AW: gleiche Werte suchen und Zellen markieren
07.11.2006 21:02:22
Stefan
Hallo Nico,
Kein Problem, das hattest Du ja im Prinzip schon, ausser dass ich denke dass Du's nirgendwo hingeschrieben hast. Jetzt wird die Summe in die Zelle A1 geschrieben.

Sub gleiche_Werte()
Dim Summe As Variant
Dim Name As Variant
Dim z As Integer
Name = ActiveCell.Value
z = 2
If ActiveCell.Column <> z Or ActiveCell.Value = "" Then
MsgBox ("Wähle zuerst einen Werte aus Spalte B."), vbCritical, "FEHLER"
Else
Range("B2").Select
Do Until ActiveCell.Value = ""
If ActiveCell.Value = Name Then
ActiveCell.Offset(0, 8).Interior.ColorIndex = 37
If IsNumeric(ActiveCell.Value) Then Summe = Summe + ActiveCell.Value
End If
ActiveCell.Offset(1, 0).Select
Loop
End If
Cells(1, 1).Value = Summe
End Sub

Schoene Gruesse
Stefan
Anzeige
AW: gleiche Werte suchen und Zellen markieren
08.11.2006 09:39:46
Nico
Hallo Stefan,
mein Code sieht nun wie folgt aus:

Sub gleiche_werte()
Dim Summe As Variant
Dim Name As Variant
Dim z As Integer
Name = ActiveCell.Value
z = 2
If ActiveCell.Column <> z Or ActiveCell.Value = "" Then
MsgBox ("Wähle zuerst einen Wert aus Spalte B."), vbCritical, "FEHLER"
Else
Range("B2").Select
Do Until ActiveCell.Value = ""
If ActiveCell.Value = Name Then
ActiveCell.Offset(0, 8).Interior.ColorIndex = 37
ActiveCell.Offset(0, 8).Select
Summe = Summe + ActiveCell.Value
End If
ActiveCell.Offset(1, 0).Select
Loop
End If
Cells(1, 11).Value = Summe
End Sub

Der korrekte Wert wird markiert und auch in die vorgesehene Zelle geschrieben. Wenn ich aber in der Referenzspalte identische Werte hab, dann wird immer nur der Wert in der aktuellen Zeile markiert, auch die Summenbildung funktioniert nicht.
Ich kenne mich leider nicht gut genug aus, um das Problem selbst zu lösen ... :=(
Danke.
Nico
Anzeige
AW: gleiche Werte suchen und Zellen markieren
08.11.2006 12:57:58
Stefan
Hallo Nico,
Da hab ich Deine Vorgaben nicht genau genug durchgelesen. Sorry... ich dachte die Zellen zum Aufaddieren sind die in der Spalte B.
Beim Versuch das zu korregieren hast Du dann die aktive Zelle so verschoben, dass das Makro nur noch einen Wert fand.
Hier die (hoffentlich) richtige Fassung:

Sub gleiche_werte()
Dim Summe As Variant
Dim Name As Variant
Dim z As Integer
Name = ActiveCell.Value
z = 2
If ActiveCell.Column <> z Or ActiveCell.Value = "" Then
MsgBox ("Wähle zuerst einen Wert aus Spalte B."), vbCritical, "FEHLER"
Else
Range("B2").Select
Do Until ActiveCell.Value = ""
If ActiveCell.Value = Name Then
ActiveCell.Offset(0, 8).Interior.ColorIndex = 37
Summe = Summe + ActiveCell.Offset(0, 8).Value
End If
ActiveCell.Offset(1, 0).Select
Loop
End If
Cells(1, 11).Value = Summe
End Sub

Schoene Gruesse
Stefan
Anzeige
AW: gleiche Werte suchen und Zellen markieren
08.11.2006 13:06:24
Nico
Hallo Stefan,
vielen Dank. Das klappt nun perfekt. Ich will das auch können ... :=)
Nochmals danke für Deine tolle Hilfe.
Nico
Gern geschehen o.w.T.
08.11.2006 13:19:54
Stefan
AW: gleiche Werte suchen und Zellen markieren
07.11.2006 20:16:18
Heide_Tr
hallo Nico,
so schlecht ist Dein Ansatz gar nicht.
Wenn nicht wirklich nötig, sollte man Selects vermeiden. Aus:
ActiveCell.Offset(0, 8).Select
Selection.Interior.ColorIndex = 37
Sollte man:
ActiveCell.Offset(0, 8).Interior.ColorIndex = 37
machen.
Manchmal ist die Selektion nicht zu vermeiden. Im nachfolgenden Code wird jede Fundstelle selektiert, damit man den nächsten Fundort finden kann.
So funktioniert's:


Sub gleiche_Werte()
Dim sBegriff As String
  If ActiveCell.Column <> 2 Or ActiveCell.Value = "" Then
        MsgBox "Wähle zuerst einen Werte aus Spalte B.", vbCritical, "FEHLER"
        Exit Sub
  Else: sBegriff = ActiveCell.Value
  End If
  Set gzelle = ActiveSheet.Columns("B").Find(What:=sBegriff, LookIn:=xlValues, _
                     LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)
  If Not gzelle Is Nothing Then
    gzelle.Activate
    Do                                                                   ' weitersuchen
      Columns("B").FindNext(After:=ActiveCell).Activate
      If ActiveCell.Row = gzelle.Row And ActiveCell.Column = gzelle.Column Then _
                          Exit Do     ' dann ist er wieder beim ersten Fund
      ActiveCell.Offset(0, 8).Interior.ColorIndex = 37
    Loop
    Set gzelle = Nothing
  End If
End Sub


viele Grüße. Heide
Anzeige

317 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige