Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
436to440
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
436to440
436to440
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Beni BITTE helfen ...

Beni BITTE helfen ...
05.06.2004 11:26:24
Steve
Artikelnummer vergleich
Hallo Beni,
du hast mir vor vier Wochen ein Makro geschrieben (siehe bitte weiter unten!) nur an eine Stelle klappt es leider nicht und zwar die Überschriften in Spalte C (d.h. in Spalte A ist keine Artikelnummer vorhanden) werden leider aus der Liste gestrichen!! Könntest du bitte so lieb sein und das berichtigen, so dass die Überschriften bleiben?
Hier nochmals alle Daten zur Auffrischung, bin dir extrem Dankbar!!!
Gruß,
Steve
Ich habe eine Liste mit acht Spalten, in Spalte A ist immer der Artikelnummer (7 stellig getrennt durch ein Punkt, z.B. 123.4567) die restlichen 7 Spalten gehören der Artikelnummer an. Diese Liste ist bereits sortiert, und der Reihenfolge darf KEINESFALLS geändert werden. Ich füge in Spalte K bis R eine Update diese Liste hinzu. **Hier ist allerdings die Reihenfolge der Artikelnummer nicht das gleiche, d.h. zum Beispiel, der Nummer in Spalte A450 könnte in Spalte K8999 sein!!** Nun soll die Artikelnummer in Spalte K mit der Artikelnummer in Spalte A verglichen werden, wenn diese übereinstimmt dann sollen die Einträge in die Spalten L bis R in die Spalten B bis H überschrieben werden. Bedingt durch diese Update brauche ich bitte auch ein Fehlerprotokoll von das was übrig bleibt. Das heißt es könnte sein das Artikelnummer in Spalte A nicht in Spalte K vorhanden sind, umgekehrt genauso, Artikelnummer in Spalte K müssen nicht in Spalte A vorhanden sein! Wäre es deswegen möglich in Tabelle 2 darüber ein Protokollmeldung auszugeben? Zum Beispiel: Artikelnummer 578.5396 (Spalte A) ist nicht in Spalte K aufgelistet, andersrum genauso, Artikelnummer 222.0410 (Spalte K) ist nicht in Spalte A aufgelistet. Hier noch ein paar Hinweise: *** Die Liste in Spalte A bis H hat Überschriften in Spalte C das heißt in Spalte A wäre keine Artikelnummer vorhanden. Auch Leerzeilen kommen vor, diese dürfen bitte nicht verändert werden!***
Das war`s schon!! Wäre super wenn mir jemand helfen konnte?!
Gruß
Steve
Hallo Steve.
jetzt sollte es funktionieren.
Gruss Beni

Sub Artikelnummer_vergleich()
Dim aZeile, kZeile As Long
For aZeile = 4 To Cells(65536, 1).End(xlUp).Row
Wert = Cells(aZeile, 1)
With Columns(11)
Set c = .Find(Wert, LookIn:=xlValues, LookAt:=xlWhole)
End With
If c Is Nothing Then
With Worksheets("Tabelle2")
r = .Cells(65536, 1).End(xlUp).Row + 1
.Cells(r, 1) = "Artikelnummer " & Wert & " aus Spalte A ist nicht in Spalte K aufgelistet"
End With
Else
Range(c(1, 2), c(1, 8)).Copy Destination:=Cells(aZeile, 2)
End If
Next aZeile
For kZeile = 4 To Cells(65536, 11).End(xlUp).Row
Wert = Cells(kZeile, 11)
With Columns(1)
Set c = .Find(Wert, LookIn:=xlValues, LookAt:=xlWhole)
End With
If c Is Nothing Then
With Worksheets("Tabelle2")
r = .Cells(65536, 1).End(xlUp).Row + 1
.Cells(r, 1) = "Artikelnummer " & Wert & " aus Spalte K ist nicht in Spalte A aufgelistet"
End With
End If
Next kZeile
End Sub

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Ueberschrift
Beni
Hallo Steve,
das mit der Ueberschrift musst Du besser erklären, aber ich kann es erst heute Abend machen.
Gruss Beni
AW: Beni BITTE helfen ...
05.06.2004 12:06:03
Nepumuk
Hallo Steve,
bin zwar nicht Beni, aber bitte:


Sub Artikelnummer_vergleich()
    Dim lngZeile As Long, myRange As Range
    Application.ScreenUpdating = False
    For lngZeile = 4 To Cells(65536, 1).End(xlUp).Row
        If Trim(Cells(lngZeile, 1)) <> "" Then
            Set myRange = Columns(11).Find(Cells(lngZeile, 1), LookIn:=xlValues, LookAt:=xlWhole)
            If myRange Is Nothing Then
                With Worksheets("Tabelle2")
                    .Cells(.Cells(65536, 1).End(xlUp).Row + 1, 1) = "Artikelnummer " & Cells(lngZeile, 1) & " aus Spalte A ist nicht in Spalte K aufgelistet"
                End With
            Else
                Range(myRange(1, 2), myRange(1, 8)).Copy Destination:=Cells(lngZeile, 2)
            End If
        End If
    Next
    For lngZeile = 4 To Cells(65536, 11).End(xlUp).Row
        Set myRange = Columns(1).Find(Cells(lngZeile, 11), LookIn:=xlValues, LookAt:=xlWhole)
        If myRange Is Nothing Then
            With Worksheets("Tabelle2")
                .Cells(.Cells(65536, 1).End(xlUp).Row + 1, 1) = "Artikelnummer " & Cells(lngZeile, 1) & " aus Spalte K ist nicht in Spalte A aufgelistet"
            End With
        End If
    Next
    Application.ScreenUpdating = True
End Sub


Gruß
Nepumuk
Anzeige
AW: CODE
Beni
Hallo Steve,
möglicherweise habe ich Dich richtig verstanden.
Gruss Beni

Sub Artikelnummer_vergleich()
Dim aZeile, kZeile As Long
For aZeile = 3 To Cells(65536, 1).End(xlUp).Row
With Worksheets("Tabelle2")
r = .Cells(65536, 1).End(xlUp).Row + 1
If Cells(aZeile, 1) = "" And Cells(aZeile, 3) <> "" Then
.Cells(r, 1) = Cells(aZeile, 3)
.Cells(r, 1).Font.Bold = True
End If
Wert = Cells(aZeile, 1)
Set c = Columns(11).Find(Wert, LookIn:=xlValues, LookAt:=xlWhole)
If c Is Nothing Then
.Cells(r, 1) = "Artikelnummer " & Wert & " aus Spalte A ist nicht in Spalte K aufgelistet"
Else
If Wert <> "" Then Range(c(1, 2), c(1, 8)).Copy Destination:=Cells(aZeile, 2)
End If
End With
Next aZeile
For kZeile = 4 To Cells(65536, 11).End(xlUp).Row
With Worksheets("Tabelle2")
r = .Cells(65536, 1).End(xlUp).Row + 1
If Cells(aZeile, 11) = "" And Cells(aZeile, 13) <> "" Then
.Cells(r, 11) = Cells(aZeile, 13)
.Cells(r, 11).Font.Bold = True
End If
Wert = Cells(kZeile, 11)
Set c = Columns(1).Find(Wert, LookIn:=xlValues, LookAt:=xlWhole)
If c Is Nothing Then
.Cells(r, 1) = "Artikelnummer " & Wert & " aus Spalte K ist nicht in Spalte A aufgelistet"
End If
End With
Next kZeile
End Sub

Anzeige
AW: CODE
05.06.2004 19:37:09
Steve
Hallo Beni,
die Makro von dir macht die Überschriften und Leerzeilen in Spalte C jetzt richtig, Nur leider in Tabelle 2 werden diese Überschriften auch mit übernommen! (Aber wie gesagt sonst werde alles passen!) Vielen Dank.
Gruß,
Steve
Hallo Nepumuk,
**der Makro von dir: die Überschriften und Leerzeilen in Spalte C werden jetzt nicht mehr überschrieben, Danke! Aber dafür werden die Artikelnummer die in Spalte K gelistet sind und nicht in Spalte A vorhanden leider NICHT in der Tabelle 2 angezeigt!
Gruß.
Steve
Wie gesagt an alle Beide vielen Dank!
AW: CODE
06.06.2004 10:49:04
Nepumuk
Hallo Setve,
da war noch ein kleiner Fehler drin.


Public Sub Artikelnummer_vergleich()
    Dim lngZeile As Long, myRange As Range
    Application.ScreenUpdating = False
    For lngZeile = 4 To Cells(65536, 1).End(xlUp).Row
        If Trim(Cells(lngZeile, 1)) <> "" Then
            Set myRange = Columns(11).Find(Cells(lngZeile, 1), LookIn:=xlValues, LookAt:=xlWhole)
            If myRange Is Nothing Then
                With Worksheets("Tabelle2")
                    .Cells(.Cells(65536, 1).End(xlUp).Row + 1, 1) = "Artikelnummer " & Cells(lngZeile, 1) & " aus Spalte A ist nicht in Spalte K aufgelistet"
                End With
            Else
                Range(myRange(1, 2), myRange(1, 8)).Copy Destination:=Cells(lngZeile, 2)
            End If
        End If
    Next
    For lngZeile = 4 To Cells(65536, 11).End(xlUp).Row
        If Trim(Cells(lngZeile, 11)) <> "" Then
            Set myRange = Columns(1).Find(Cells(lngZeile, 11), LookIn:=xlValues, LookAt:=xlWhole)
            If myRange Is Nothing Then
                With Worksheets("Tabelle2")
                    .Cells(.Cells(65536, 1).End(xlUp).Row + 1, 1) = "Artikelnummer " & Cells(lngZeile, 11) & " aus Spalte K ist nicht in Spalte A aufgelistet"
                End With
            End If
        End If
    Next
    Application.ScreenUpdating = True
End Sub


Gruß
Nepumuk
Anzeige
AW: CODE
06.06.2004 14:41:11
Steve
Hallo Nepumuk!
Yo, es passt alles, vielen herzlichen Dank!
Gruß
Steve

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige