title image


Smiley Re: H i l f e !!!!!!!!!!!!!!!! Ich bin nah am Herzinfarkt!!
Hallo Frank,probier das mal aus:Sub SpaltenVergleich()Dim lngZ2&, intZähler%, strErsteZelle$Dim objGefundene As ObjectDim arrAdressenSammlerDim SuchBegriffFor lngZ2 = 1 To Cells(Rows.Count, 2).End(xlUp).Row    Application.StatusBar = "Bin in Zeile " & lngZ2    SuchBegriff = Cells(lngZ2, 2)    intZähler = 0    Set objGefundene = Columns(1).Find(SuchBegriff, LookIn:=xlValues)    If Not objGefundene Is Nothing Then        stradresse = objGefundene.Address(False, False)        intZähler = 1    Else: GoTo nächste    End If    strErsteZelle = stradresse    ReDim arrAdressenSammler(1)    arrAdressenSammler(0) = stradresse    Do        Set objGefundene = Columns(1).Find(SuchBegriff, after:=Range(stradresse), LookIn:=xlValues)        intZähler = intZähler + 1        stradresse = objGefundene.Address(False, False)        If stradresse = strErsteZelle Then Exit Do        ReDim Preserve arrAdressenSammler(intZähler)        arrAdressenSammler(intZähler - 1) = stradresse    Loop    intZähler = intZähler - 1    If intZähler = 1 Then        Cells(lngZ2, 2).Interior.ColorIndex = 3        Range(arrAdressenSammler(0)).Interior.ColorIndex = 3    ElseIf intZähler > 1 Then        Cells(lngZ2, 2).Interior.ColorIndex = 6    End Ifnächste:    Set Gefunden = NothingNextApplication.StatusBar = FalseEnd SubViele GrüßeJörgFragen im Forum, aber wie? - Info's!Fragen zu Excel, Access oder Word?EWAF-FAQ-Seiten und www.joerglorenz.de durchsuchen:Code eingefügt mit CodezuHTML von Jörg Lorenz (Menü kleine Helferlein)


geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: