Daten prüfen 2 Kriterien

Guten Tag nochmal.
ich hatte das Thema vor ein paar Tagen schon mal gepostet und Timo hatte mir veruscht zu helfen, leider hat das bei mir noch nicht das richtige Ergebnis gebracht.
Ich habe eine Tabelle
https://www.herber.de/bbs/user/70482.xls
In der "Ausgabe" Tabelle soll folgendes ausgegeben werden:
Zeilenstruktur wie in "Input" Zeile 1
Es sollen die Code gelöscht werden, welche in Tabellenblatt "Bereiningung" stehen.
Baumuster in allen Berichtsgebieten
Baumuster in einzelen Berichtsgebieten
Dabei muss jeder Code einzeln geprüft werden:
Beispiel: Kommt Kombination 4513011 27800 A01 in "Input" vor, wenn ja, dann A01 in "Ausgabe" löschen und für dieses Feld ein leeres ausgeben wenn nicht, dann Wert stehen lassen und nächstes Feld Prüfen. Danach 4513011 27800 474 prüfen usw. Wenn anstelle alle ein Berichtsgebiet steht, dann nur dieses Prüfen.
Man kann das über Excel Formeln lösen, (siehe Tabllenblatt "Test") so lange alle Baumuster geprüft werden, danach wird es kompliziert und es dauert zu lange.
Kann man dies auch über ein Makro erledigen lassen?
Vielen Dank schon jetzt.
Jens

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo,
teste mal ob es diesmal passt.

Sub test()
Dim meARIn(), meARBer()
Dim A&, B&, C&, D&, maxCol&
With Tabelle2
 maxCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
 meARIn = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, maxCol)
End With

With Tabelle3
 maxCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
 meARBer = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, maxCol)
End With

For A = 1 To Ubound(meARBer)
    For B = 1 To Ubound(meARIn)
        If meARIn(B, 3) = meARBer(A, 1) Then
            If meARBer(A, 2) = "alle" Or meARIn(B, 5) = meARBer(A, 2) Then
                For C = 3 To Ubound(meARBer, 2)
                        If meARBer(A, C) = "" Then Exit For
                        
                        For D = 6 To Ubound(meARIn)
                            If Trim(meARBer(A, C)) = Trim(meARIn(B, D)) Then _
                                meARIn(B, D) = Empty
                        Next D
                Next C
            End If
        End If
    Next B
Next A

With Tabelle4
    .Range("A2", .Cells(.Rows.Count, .UsedRange.Columns.Count)).Clear
    With .Range("A2").Resize(Ubound(meARIn), Ubound(meARIn, 2))
        .Cells = meARIn
        .EntireColumn.AutoFit
    End With
End With
End Sub

Hier noch die Test Mappe
https://www.herber.de/bbs/user/70798.xls
Gruß Tino

Sub test() Dim meARIn(), meARBer() Dim A&, B&, C&, D&, maxCol& With Tabelle2 maxCol = .Cells(1, .Columns.Count).End(xlToLeft).Column meARIn = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, maxCol) End With With Tabelle3 maxCol = .Cells(1, .Columns.Count).End(xlToLeft).Column meARBer = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, maxCol) End With For A = 1 To Ubound(meARBer) For B = 1 To Ubound(meARIn) If meARIn(B, 3) = meARBer(A, 1) Then If meARBer(A, 2) = "alle" Or meARIn(B, 5) = meARBer(A, 2) Then For C = 3 To Ubound(meARBer, 2) If meARBer(A, C) = "" Then Exit For For D = 6 To Ubound(meARIn, 2) If Trim(meARBer(A, C)) = Trim(meARIn(B, D)) Then _ meARIn(B, D) = Empty Next D Next C End If End If Next B Next A With Tabelle4 .Range("A2", .Cells(.Rows.Count, .UsedRange.Columns.Count)).Clear With .Range("A2").Resize(Ubound(meARIn), Ubound(meARIn, 2)) .Cells = meARIn .EntireColumn.AutoFit End With .Activate End With End Sub

Beliebteste Forumthreads (12 Monate)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread