benötige hilfe zwecks Macro

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.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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/

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

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

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread