Herbers Excel-Forum - das Archiv

benötige hilfe zwecks Macro

Bild

Betrifft: benötige hilfe zwecks Macro
von: Christian T.
Geschrieben am: 25.09.2003 09:55:04
Hallo,

ich habe ein ziemlich großes Problem und möchte dies gerne anhand eines Macros lösen.

Also ich habe zwei Stücklisten mit Bauteilnummern in der befinden sich 3000 Nummern (SPALTE A) in der anderen 1350 Bauteilnummern (SPALTE B).

Nun habe ich die beiden Spalten mit den Nummern in ein neues Excel Dokument kopiert und will nun ein Macro schreiben, welches z.B.

1. Zelle A1 kopiert
2. in der zweiten Bauteilliste (SPALTE B) nach dieser Nummer Sucht.
3. Wenn sie nicht in der SPALTE B zu finden ist soll A1 rot eingefärbt werden
4. Wenn die Nummer vorhanden ist bitte die gefundenen Nummern in SPALTE B grün einfärben.
5. Danach die Spalte B nach der Nummer aus Zelle A2 durchsuchen
...
*. Danach die Spalte B nach der Nummer aus Zelle A3 durchsuchen

Das dürfte doch eigentlich nicht so schwer sein, oder ??? allerdings kenne ich mich nicht sehr gut mit VB aus!!!

Schöne Grüsse,

Christian T.

Bild

Betrifft: AW: benötige hilfe zwecks Macro
von: Hajo_Zi
Geschrieben am: 25.09.2003 10:06:04
Hallo Christian

mal ohne Testung, Tabellennamen anpassen.

Sub Tabellen_Vergleichen3()
'   erstellt von Hajo.Ziplies@web.de 25.09.03
' http://home.media-n.de/ziplies/
'   2 Splten vergleichen
'   Tabelle1 Original Spalte A,  Tabelle 2 Kopie Spalte B
'   alle Werte die gefunden in Spalte B Rot in Spalte B, nicht gefunden Grün in Spalte A
Dim LoI As Long
Dim LoJ As Long
Dim LoLetzte1 As Long
Dim LoLetzte2 As Long
Dim BoNein As Boolean
LoLetzte1 = 65536
With Worksheets("Tabelle1")
If .Range("A65536") = "" Then LoLetzte1 = .Range("A65536").End(xlUp).Row
End With
LoLetzte2 = 65536
With Worksheets("Tabelle1")
If .Range("B65536") = "" Then LoLetzte2 = .Range("B65536").End(xlUp).Row
End With
For LoI = 1 To LoLetzte1
For LoJ = 1 To LoLetzte2
If Worksheets("Tabelle1").Cells(LoI, 1) = Worksheets("Tabelle2").Cells(LoJ, 2) Then
Worksheets("Tabelle1").Cells(LoJ, 2).Interior.ColorIndex = 3
BoNein = True
End If
Next LoJ
If BoNein = True Then
Worksheets("Tabelle1").Cells(LoJ, 1).Interior.ColorIndex = 4
BoNein = False
End If
Next LoI
End Sub



Falls Code vorhanden wurde dieser getestet unter Betriebssystem XP Pro und Excel Version XP SBE.
Bitte kein Mail, Probleme sollen im Forum gelöst werden.

Microsoft MVP für Excel

Das Forum lebt auch von den Rückmeldungen.

Zurzeit gibt es wieder Probleme mit der E-Mail Benachrichtigung.

Ich bekomme Mails zu Beiträgen an denen ich nicht beteiligt bin und zusätzlich noch Mails zu meinen eigenen Beiträgen.
Das Problem mit den eigenen Benachrichtigung kann gelöst werden durch Lösche und Neuanmelden. Dieses möchte ich aber nicht jeden Tag machen.
Um dieses Problem erstmal zu beseitigen habe ich die automatische Mailbenachrichtigung abgeschaltet.
Aus diesem Grunde ist es dem Zufall überlassen ob auf Rückfragen Antworten von mir kommen.


http://home.media-n.de/ziplies/

Bild

Betrifft: AW: benötige hilfe zwecks Macro
von: Dirk
Geschrieben am: 25.09.2003 10:10:56
Habs mal so gelöst.
Sub suche()
i = 1
j = 1
Do Until Range("A" & i).Value = ""
bol = 0
Do Until Range("B" & j).Value = ""
If Range("A" & i).Value = Range("B" & j).Value Then
Range("B" & j).Interior.ColorIndex = 4
bol = 1
Exit Do
End If
j = j + 1
Loop
If bol = 0 Then
Range("A" & i).Interior.ColorIndex = 3
End If
j = 1
i = i + 1
Loop
End Sub

Bild

Betrifft: AW: benötige hilfe zwecks Macro
von: Christian T.
Geschrieben am: 25.09.2003 11:05:00
Hallo Dirk und Hajo_Zi,

vielen Dank für Eure Hilfe. Ihr habt mir so ca. 6 Stunden Arbeit gespart :)
Hajo, dein Macro lief nicht, Dirk`s dagegen umso besser.

Allerdings müsste noch ein kleines Problem gelöst werden.

Dass in SPALTE B auch mehrere Nummern grün eingefärbt werden können (wenn die zu suchende Nummer z.B. dreimal vorhanden ist)

Schöne Grüsse und nochmal vielen Dank,

Christian T.
Bild

Betrifft: AW: benötige hilfe zwecks Macro
von: Hajo_Zi
Geschrieben am: 25.09.2003 12:23:10
Hallo Christian

es war noch ein Problem mit dem Bezug.

Sub Tabellen_Vergleichen3()
'   erstellt von Hajo.Ziplies@web.de 25.09.03
' http://home.media-n.de/ziplies/
'   2 Splten vergleichen
'   Tabelle1 Original Spalte A,  Tabelle 2 Kopie Spalte B
'   alle Werte die gefunden in Spalte B Rot in Spalte B, nicht gefunden Grün in Spalte A
Dim LoI As Long
Dim LoJ As Long
Dim LoLetzte1 As Long
Dim LoLetzte2 As Long
Dim BoNein As Boolean
LoLetzte1 = 65536
With Worksheets("Tabelle1")
If .Range("A65536") = "" Then LoLetzte1 = .Range("A65536").End(xlUp).Row
End With
LoLetzte2 = 65536
With Worksheets("Tabelle1")
If .Range("B65536") = "" Then LoLetzte2 = .Range("B65536").End(xlUp).Row
End With
For LoI = 1 To LoLetzte1
For LoJ = 1 To LoLetzte2
If Worksheets("Tabelle1").Cells(LoI, 1) = Worksheets("Tabelle1").Cells(LoJ, 2) Then
Worksheets("Tabelle1").Cells(LoJ, 2).Interior.ColorIndex = 3
BoNein = True
End If
Next LoJ
If BoNein = False Then
Worksheets("Tabelle1").Cells(LoI, 1).Interior.ColorIndex = 4
End If
BoNein = False
Next LoI
End Sub



Falls Code vorhanden wurde dieser getestet unter Betriebssystem XP Pro und Excel Version XP SBE.
Bitte kein Mail, Probleme sollen im Forum gelöst werden.

Microsoft MVP für Excel

Das Forum lebt auch von den Rückmeldungen.

http://home.media-n.de/ziplies/

 Bild