Gruppen

Top Gruppen: Windows 7; Windows Vista; Windows XP; Textverarbeitung; Excel; DSL; Internet Browser; E-Mail/Outlook
Betriebsysteme: Windows classik; Linux; BS-Sonstige
Software: Datenbanken; Bildbearbeitung; Audio/mp3/Video; Security/Viren; SW-Sonstige
Hardware: Mainboard/CPU; Grafikkarten; Peripherie; Laptop/Notebook; HW-Sonstiges
Netzwerk: Telefon,ISDN,Modem; W-Lan; NW-Sonstiges
Programmierung: PHP,ASP,Perl...; Java,C++...; Webseiten/HTML
Sonstiges: PC-Sonstiges; Plauderecke; SN Intern; Test

/ Forum / Skripte(PHP,ASP,Perl...)

Skripte(PHP,ASP,Perl...)

Fragevon majoplinka vom 30.01.2020, 17:41 Options

Hlife zu Excel / VBA

Moin, brauch mal wieder kluge Leute!!!

mein problem

ich habe zwei bereiche:
bereich 1 "b2" bis "b30"
bereich 2 "b50" bis "b60"

im bereich 2 sollen texte oder zahlen hinterlegt werden
und wenn im bereich 1 ein gleicher text oder zahl aus bereich 2 vorkommt soll die zelle mit dem gleichem wert im bereich 1 rot werden!

ein dickes danke schon im vorraus!!

Antwort schreiben

Antwort 1 von gast123 vom 31.01.2020, 14:49 Options

hi all :-)

ein beispiel

gruss gast123

einzufuegen
alt+f11/projektexplorer/DeineTabelle

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim suche As Range
If Target.Column = 2 And Target.Row > 49 And Target.Row < 61 Then
Set suche = Workbooks(1).Worksheets(1).Range("B2:B30").Find(Cells(Target.Row, Target.Column))
If Not suche Is Nothing Then
Workbooks(1).Worksheets(1).Cells(suche.Row, 2).Interior.ColorIndex = 3
End If
End If
Application.EnableEvents = True
End Sub

Antwort 2 von majoplinka vom 31.01.2020, 19:43 Options

klapt super!!

so jetzt würde ich den bereich 2 gerne auf "c20" bis "c40" setzen und wenn das wort bzw. zahl auf dem bereich 2 gelöscht wird soll auch im bereich 1 die zelle in ihre Uhrsprungs farbe (keine!) annehmen!

schon mal ein fettes DANKE!!

Antwort 3 von gast123 vom 01.02.2020, 10:19 Options

hi all

wie gewuenscht

gruss gast123

einzufuegen in ein allgemeines modul

Global findex As Variant

einzufuegen alt+f11/projektexplorer/DeineTabelle

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim suche As Range
Dim suche1 As Range
If Target.Column = 3 And Target.Row > 19 And Target.Row < 41 Then
Set suche = Workbooks(1).Worksheets(1).Range("B2:B30").Find(Cells(Target.Row, Target.Column))
If Not suche Is Nothing Then
Workbooks(1).Worksheets(1).Cells(suche.Row, 2).Interior.ColorIndex = 3
End If
End If
If findex <> Workbooks(1).Worksheets(1).Cells(Target.Row, 3) And findex <> "" Then
Set suche1 = Workbooks(1).Worksheets(1).Range("B2:B30").Find(findex)
If Not suche1 Is Nothing Then
Workbooks(1).Worksheets(1).Cells(suche1.Row, 2).Interior.ColorIndex = xlNone
End If
End If
findex = ""
Application.EnableEvents = True
End Sub

einzufuegen alt+f11/projektexplorer/DeineTabelle

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 3 And Target.Row > 19 And Target.Row < 41 Then
findex = Workbooks(1).Worksheets(1).Cells(Target.Row, 3)
End If
Application.EnableEvents = True
End Sub

Antwort 4 von gast123 vom 01.02.2020, 10:25 Options

hi all :-)

code optimierungen waeren immer willkommen trotz der gegenlaeufigen trends in foren

gruss gast123

Antwort 5 von gast123 vom 01.02.2020, 10:37 Options

gast123

vielleicht uebersichtlicher

gruss gast123

Global findex As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim suche As Range
Dim suche1 As Range
If Target.Column = 3 And Target.Row > 19 And Target.Row < 41 Then
Set suche = Workbooks(1).Worksheets(1).Range("B2:B30").Find(Cells(Target.Row, Target.Column))
If Not suche Is Nothing Then
Workbooks(1).Worksheets(1).Cells(suche.Row, 2).Interior.ColorIndex = 3
Else
If findex <> "" Then
Set suche1 = Workbooks(1).Worksheets(1).Range("B2:B30").Find(findex)
If Not suche1 Is Nothing Then
Workbooks(1).Worksheets(1).Cells(suche1.Row, 2).Interior.ColorIndex = xlNone
End If
End If
End If
End If
findex = ""
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 3 And Target.Row > 19 And Target.Row < 41 Then
findex = Workbooks(1).Worksheets(1).Cells(Target.Row, 3)
End If
Application.EnableEvents = True
End Sub

Antwort 6 von majoplinka vom 01.02.2020, 18:24 Options

Moin ein fette Dankeschön, aber ich habe immer noch das problem mit dem zurück färben!

also wenn der bereich 1 (eine ZELLE) sich rot gefärbt hat und ich dann das wort aus den bereich 2 lösche dann ist die zelle immer noch rot!

Antwort 7 von gast123 vom 02.02.2020, 19:35 Options

hi all

kontrolliere deinen bereich und passe das makro gegebenenfalls an

gruss gast123

Antwort 8 von gast123 vom 03.02.2020, 10:36 Options

hi majoplinka

2 verschiedene bereiche hast nun schon angegeben vielleicht hast nun sogar 3 ,du solltest dir im klaren werden welche bereiche nun gueltig sein sollten,ein letzter versuch ,sag deine bereiche korrekt an sonst wird das wohl nix

gruss gast123

Antwort 9 von majoplinka vom 03.02.2020, 15:25 Options

hej, ich versuchs noch mal

Range("B2:B30") = bereich 1

Target.Column = 3 And Target.Row > 19 And Target.Row < 41 Then =bereich 2

so bereich 1 ist voll mir Wörtern und zahlen! (farbe keine)

trage in bereich 2 zahlen und wörter ein!

zellen im bereich 1 werden rot!

DAS klappt ja super!

aber jetzt wenn ich im bereich 2 einen wert lösche z.b. auto
soll jetzt die zelle im bereich1 (die rot ist) wieder farblos werden da im bereich 2 das wort nicht mehr steht!

Antwort 10 von gast123 vom 04.02.2020, 16:42 Options

hi majoplinka :-)

ich glaub es war noch fehlerbehaftet,probier das mal

gruss gast123

Global findex As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim suche As Range
Dim suche1 As Range
If Target.Column = 3 And Target.Row > 19 And Target.Row < 41 Then
Set suche = Workbooks(1).Worksheets(1).Range("B2:B30").Find(Cells(Target.Row, Target.Column))
If Not suche Is Nothing And Workbooks(1).Worksheets(1).Cells(Target.Row, 3) <> "" Then
Workbooks(1).Worksheets(1).Cells(suche.Row, 2).Interior.ColorIndex = 3
Else
Set suche1 = Workbooks(1).Worksheets(1).Range("B2:B30").Find(findex)
If Not suche1 Is Nothing Then
Workbooks(1).Worksheets(1).Cells(suche1.Row, 2).Interior.ColorIndex = xlNone
End If
End If
End If
findex = ""
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 3 And Target.Row > 19 And Target.Row < 41 Then
findex = Workbooks(1).Worksheets(1).Cells(Target.Row, 3)
End If
Application.EnableEvents = True
End Sub

Antwort 11 von majoplinka vom 05.02.2020, 15:56 Options

tach,

nach dem rein kopieren wird

Global findex As Variant rot und ich bekomme folgende fehler meldung

Fehler beim Kompilieren:

Konstanten, Zeichenfolgen fester Längen, benutzeerdefinirte Datenfelder und Declare-Anweisungen sind als Public-Elements von Objektmodulen nicht zugelassen

Was mach ich falsch??

Antwort 12 von gast123 vom 05.02.2020, 16:03 Options

hi majoplinka

antwort 3 ist beschrieben wo was einfuegt werden soll,so bitte einzuordnen

1 zeile in ein allgemeines modul
1+2 makro hinter die tabelle

gruss gast123

Antwort 13 von majoplinka vom 05.02.2020, 18:25 Options

moin,

habe es in "diese arbeitsmappe -> allgemein" eingefügt und dann bekomme ich folgendes

---------------------------
Microsoft Visual Basic
---------------------------
Fehler beim Kompilieren:

Konstanten, Zeichenfolgen fester Länge, benutzerdefinierte Datenfelder und Declare-Anweisungen sind als Public-Elemente von Objektmodulen nicht zugelassen.
---------------------------
OK Hilfe
---------------------------

Antwort 14 von gast123 vom 05.02.2020, 19:31 Options

hi

link zu einer beispieldatei

gruss gast123

http://www.netupload.de/detail.php?img=b60c5eaea54b72d3edaa6c03c170...

Antwort 15 von majoplinka vom 06.02.2020, 15:59 Options

cool danke!!!

Hinweis

Diese Frage ist schon etwas älter, Sie können daher nicht mehr auf sie antworten. Sollte Ihre Frage noch nicht gelöst sein, stellen Sie einfach eine neue Frage im Forum..

Neue Einträge

Tipp einschicken

News einschicken