Doppelte Makros sichbar machen DRINGEND

Dieses Thema Doppelte Makros sichbar machen DRINGEND im Forum "Microsoft Office Suite" wurde erstellt von Stolley, 20. Juni 2007.

Thema: Doppelte Makros sichbar machen DRINGEND Hallo, ich habe folgendes Problem, dass ich ohne vorher im Forum zu suchen hier herein schreibe, weil ich dieses...

  1. Hallo,

    ich habe folgendes Problem, dass ich ohne vorher im Forum zu suchen hier herein schreibe, weil ich dieses Problem bis spätestens Freitag halb 3 behoben haben muss: Also Dringend.

    Ich habe eine Liste in Excel (Office 97) die aus Mehreren Spalten besteht.

    Nun kann es vorkommen, dass es in der 2. spalte zahlen doppelt gibt...

    Ich brauche ein Makro, dass mir diese Doppelten & das ORIGINAL markiert NUR IN SPALTE 2

    Zudem sollte es eine 2. Zahl die doppelt erscheint andersfarbig markieren...

    Am besten wäre es wenn dieses Makro fertig als Schaltfläche in Excel einfügabr wäre!!

    Bitte um Hilfe so schnell es geht und jemanden der mir sowas fertig und erprobt erstellen könnte !! Ich wäre sehr dankbar !!

    Falls jemand bereit ist einfach posten und ich werde meine Email bekanntgeben um die ergebnisse zu empfangen

    Danke im Vorraus

    Stolley
     
  2. Hallo stolley,

    geht auch ohne mail-Adresse ;D

    Ich hab dir 2 Makros geschrieben:

    1)
    Sub Spalte2DoppelteMarkieren()
    '*** mehrfach vorkommende Werte in Spalte 2 auf dem aktiven Blatt werden farblich gekennzeichnet
    '*** erste Vorkommen: Orange, zweites und weiter Vorkommen rot

    2)
    Sub Spalte2NaechsteVorkommen()
    '*** springt von der aktuellen Zelle in Spalte 2
    '*** zur Zelle in Spalte 2 mit dem nächsten Vorkommen des Wertes

    Mit dem 2ten kannst Du dann den korrespondierenden Wert suchen.

    Gruß Matjes :)

    Code:
    Option Explicit
     
    Private Const cZAB = 2 -> ab Zeile 2
    Private Const cSP2 = 2
    Private Const cFARBID_ROT = 3
    Private Const cFARBID_ORANGE = 40
    
    Sub Spalte2DoppelteMarkieren()
    '*** mehrfach Vorkommende Werte in Spalte 2 auf dem aktiven Blatt
    '*** werden farblich gekennzeichnet
    '*** erste Vorkommen: Orange, zweites und weiter Vorkommen rot
     
     Dim ws As Worksheet, r As Range, Zelle As Range
     Dim lRowS As Long, lRowBefore As Long, z As Long, lAnzMehrfach As Long, lA As Long
     Dim sAddr As String
     Dim vVar As Variant
     
     Set ws = ActiveSheet
    ->max.Zeilezahl bestimmen
     lRowS = ws.Cells(ws.Rows.Count, cSP2).End(xlUp).Row
    ->Farbmarkierung löschen
     ws.Range(ws.Cells(cZAB, cSP2), ws.Cells(lRowS, cSP2)).Interior.ColorIndex = xlColorIndexNone
     
    ->Alle Zeilen untersuchen
     Set r = ws.Range(ws.Cells(cZAB, cSP2), ws.Cells(lRowS, cSP2))
     
     For z = cZAB To lRowS
      If ws.Cells(z, cSP2).Value <>  Then
       If ws.Cells(z, cSP2).Interior.ColorIndex = xlColorIndexNone Then
        vVar = ws.Cells(z, cSP2).Value
        If z = cZAB Then lRowBefore = lRowS Else lRowBefore = z - 1
        Set Zelle = r.Find( _
         What:=vVar, _
         After:=ws.Cells(lRowBefore, cSP2), _
         LookIn:=xlValues, _
         Lookat:=xlWhole, _
         Searchdirection:=xlNext)
        sAddr = Zelle.Address(False, False)
        lA = 0
        Do
         Set Zelle = r.FindNext(Zelle)
         If Zelle Is Nothing Then Exit Do
         If sAddr = Zelle.Address(False, False) Then Exit Do
         If lA = 0 Then lA = lA + 1
         ws.Cells(z, cSP2).Interior.ColorIndex = cFARBID_ORANGE
         Zelle.Interior.ColorIndex = cFARBID_ROT
        Loop
        lAnzMehrfach = lAnzMehrfach + lA
       End If
      End If
     Next
     
     If lAnzMehrfach = 0 Then
      MsgBox Keine Werte mehrfach vorhanden.
     Else
      MsgBox lAnzMehrfach &  Werte mehrfach vorhanden.
     End If
    AUFRAEUMEN:
     Set ws = Nothing: Set r = Nothing: Set Zelle = Nothing
    End Sub
    '*****************************************************************
    
    Sub Spalte2NaechsteVorkommen()
    '*** springt von der aktuellen Zelle in Spalte 2
    '*** zur Zelle in Spalte 2 mit dem nächsten Vorkommen des Wertes
     
     Dim ws As Worksheet, r As Range, Zelle As Range
     Dim lRowS As Long, lRowBefore As Long, z As Long
     Dim sAddr As String
     Dim vVar As Variant
     
     Set ws = ActiveSheet
     
     If Not Selection.Count = 1 Then _
      MsgBox Bitte nur eine Zelle markieren.: GoTo AUFRAEUMEN
     If Selection.Column <> 2 Then _
      MsgBox Bitte eine Zelle in Spalte  & cSP2 &  markieren.: GoTo AUFRAEUMEN
     If Selection.Row < cZAB Then _
      MsgBox Bitte eine Zelle ab Zeile  & cZAB &  markieren.: GoTo AUFRAEUMEN
     
     Set Zelle = Selection
     If Zelle.Value =  Then MsgBox Zelle ist leer: GoTo AUFRAEUMEN
     
    ->max.Zeilezahl bestimmen
     lRowS = ws.Cells(ws.Rows.Count, cSP2).End(xlUp).Row
     
     Set r = ws.Range(ws.Cells(cZAB, cSP2), ws.Cells(lRowS, cSP2))
     sAddr = Zelle.Address(False, False)
     vVar = Zelle.Value
     Set Zelle = r.Find( _
         What:=vVar, _
         After:=Zelle, _
         LookIn:=xlValues, _
         Lookat:=xlWhole, _
         Searchdirection:=xlNext)
     If Zelle Is Nothing Then MsgBox Wert kommt nur einmal vor. Else Zelle.Select
     
    AUFRAEUMEN:
     Set ws = Nothing: Set r = Nothing: Set Zelle = Nothing
    End Sub
     
  3. Will ja nicht dumm rüberkommen, aber wie kann ich sowas dann gut in excel einbinden??

    Bräuchte ne datei, die man nur anklicken braucht oder so!
     
  4. Hallo Stolley,

    entweder nimmst Du deine Excel-Datei mit den Zahlen oder eine neue.

    Ich helf dir mal auf die Sprünge:

    Makros in eine neue Datei packen:
    a) neu Excel-Datei öffnen
    b) Speichern unter->vernünftigem Name' (z.B. Excel_Makros_Sp2DoppelteKennz.xls)
    c) VB-Editor öffnen (mit Alt+F11)
    d) Im Projekt-Fenster mit der rechten Maustaste auf VBAProject(Excel_Makros_Sp2DoppelteKennz.xls) klicken und Einfügen->Modul wählen
    (es öffnet sich ein Modul-Fenster)
    e) per Copy und Paste den kompletten Text aus dem grauen Fenster in dieser Modul-Fenster kopieren.
    f) mit Strg+S speichern
    g) VB-Editor schliessen ( mit Alt+Q)
    h) Datei schliessen

    Jetzt sind die Makros in der Datei Excel_Makros_Sp2DoppelteKennz.xls gespeichert.

    Sicherheitseinstellungen brauchen wir nicht beachten, da du ja Excel97 hast.


    So jetzt machen wir einen Ptrobelauf:

    a) Excel_Makros_Sp2DoppelteKennz.xls öffnen, dabei die Nachfrage, ob Makros ausgeführt werden sollen, mit Ja beantworten.
    b) Deine Excel-Datei mit den Zahlen öffnen und das Blatt mit den Zahlen in Spalte 2 in den Vordergrund bringen.
    c) Unter Extras->Makro->Makros (oder kurz Alt+F8) Spalte2DoppelteMarkieren markieren -> Ausführen

    Jetzt erhälst du eine Meldung, wieviel doppelte Werte gefunden wurden und die doppelten Werte sind farblich hinterlegt.


    Wenn du möchtest kannst Du das 2. Makro ausführen. Selektiere dazu eine farblich hinterlegte Zelle in Spalte 2 und führe das Makro aus:
    Unter Extras->Makro->Makros (oder kurz Alt+F8)
    Spalte2NaechsteVorkommen markieren -> Ausführen

    Gruß Matjes :)
     
  5. Danke Danke,

    alles hat hervorragend geklappt.

    Perfekte Lösung!!!

    Gruß Stolley
     
Die Seite wird geladen...

Doppelte Makros sichbar machen DRINGEND - Ähnliche Themen

Forum Datum
doppelte dateien Software: Empfehlungen, Gesuche & Problemlösungen 13. März 2015
Doppelte Symbole bei Programmen auf dem Desktop Windows 7 Forum 12. März 2014
Netzwerk doppelter Eintrag Windows XP Forum 16. März 2013
USB Umts STick Xs Manager nach Neuinstallation doppelte Einträge Hardware 27. Okt. 2011
doppelter Programmordner und Desktopicons Windows XP Forum 4. Jan. 2010