Microsoft Excel

Herbers Excel/VBA-Archiv

Spalten + Zeilen nach Werten aus Liste durchsuchen


Betrifft: Spalten + Zeilen nach Werten aus Liste durchsuchen von: Manuel Damerow
Geschrieben am: 22.08.2016 16:09:05

Hallo zusammen,

ich bräuchte bitte Eure Hilfe beim Suchen nach Fehlern nach dem Einlesen einer CSV Datei. Ich habe 2 Tabellen, "Einlesen" und "Setup".

In Spalte "R" der Tabelle "Einlesen" suche ich jede Zeile (Zelle) einzeln nach Werten aus einer Liste ab. Diese Liste findet sich auf dem Blatt "Setup", Spalte Z, Zeile 5 bis 8.

Wenn ich jetzt den Wert aus der Liste NICHT finde, möchte ich, dass die Zeile in der wir gerade "hängen" nach rechts hin durchsucht wird. Dort sollte dann der Werte aus der Liste vorhanden sein. Wenn dieser WErt dann gefunden wurde, soll ein Bereich (von dieser Zell bis Spalte IV) nach links kopiert werden und zwar in Spalte R.

Ich verzweifel leider, könnt ihr mir helfen? Das Problem ist, dass die Tabellen um die 2.500 Zeilen haben und es händisch zu lange dauern würde.

Danke und Gruß,

Manuel

  

Betrifft: AW: eine kleine Beispieldatei durchsuchen ... von: ... neopa C
Geschrieben am: 22.08.2016 16:20:05

Hallo Manuel,

... von bis zu max 20 Datensätzen, die Du hier einstellst und an der Du an zwei Beispielen aufzeigst, was Du anstrebst könnte hilfreich sein.

Gruß Werner
.. , - ...


  

Betrifft: AW: eine kleine Beispieldatei durchsuchen ... von: Manuel Damerow
Geschrieben am: 23.08.2016 13:32:10

Hallo Werner,

danke für dein Feedback, du hast natürlich Recht.

Hier einmal die Beispieldatei in kurz: https://www.herber.de/bbs/user/107796.xlsm

Spalte R ist die Spalte, die die Basis darstellen muss. Dort muss jede Zelle nach DFC oder F/C oder P/P oder T/P durchsucht werden. In der Beispieldatei habe ich die korrekten Werte jetzt einmal grün markiert in Spalte R. Sprich ist der Wert vorhanden, soll die nächste Zelle durchsucht werden.

Ist die Zelle in Spalte R rot markiert, heißt das, dass der gesuchte Wert weiter rechts in der Tabelle steht. Nehmen wir als Beispiel einmal Zeile 4. Hier steht der gesuchte Werte nun in Spalte S statt R. Das Makro soll also im ersten Schritt prüfen, ob einer der gesuchten Werte in Spalte R steht, wenn nicht dann sollen diese Werte in Spalte S, T, U, V, usw. gesucht werden (hier reicht es bis AG, weiter hinten werden die nicht vorkommen). Wenn die gefunden wurden, wie hier im Beispiel in Spalte S, Zeile 4, soll alles ab Spalte S nach vorne gezogen werden, so dass "P/P" in Spalte R steht. Also sollte hier der Bereich "S4:IV4" verschoben werden nach "R4". In Zeile 10 z.B. von AA10:IV10 nach R10. IV ist das Maximum. Mehr Spalten wird es auf gar keinen Fall geben.

In den orange markierten Zeilen kommen die Werte nun gar nicht vor, diese können gelöscht werden.

Vielen Dank für die Hilfe im Voraus.

Gruß,

Manuel


  

Betrifft: AW: eine kleine Beispieldatei durchsuchen ... von: Manuel Damerow
Geschrieben am: 23.08.2016 14:36:27

Hi,

ich habe noch gebastelt. Ich kriege auch alles ausgewählt etc. Ich scheiter allerdings an der Suche in der Zeile. Mein Code bisher:

Sub t()

Dim letzteZeile As Long
 letzteZeile = Sheets("Basis").Range("A65536").End(xlUp).Row

 Dim i As Integer
 i = 1

 Do While i < letzteZeile
    If Sheets("Basis").Cells(i, 18) = "DFC" Then
           i = i + 1
       ElseIf Sheets("Basis").Cells(i, 18) = "F/C" Then
               i = i + 1
           ElseIf Sheets("Basis").Cells(i, 18) = "P/P" Then
                   i = i + 1
               ElseIf Sheets("Basis").Cells(i, 18) = "T/P" Then
                       i = i + 1
    Else
        
        Dim srcRange1 As Range
        Dim srcRange2 As Range
        Dim srcRange3 As Range
        Dim srcRange4 As Range
        
        Range(Cells(i, 18), Cells(i, 256)).Select
        
        On Error Resume Next
        Set srcRange1 = Selection.Find(What:="DFC", After:=ActiveCell, Lookat:=xlWhole)
        Set srcRange2 = Selection.Find(What:="F/C", After:=ActiveCell, Lookat:=xlWhole)
        Set srcRange3 = Selection.Find(What:="P/P", After:=ActiveCell, Lookat:=xlWhole)
        Set srcRange4 = Selection.Find(What:="T/P", After:=ActiveCell, Lookat:=xlWhole)
        
        
        If srcRange1 Is Nothing Then
        End If
        
        If srcRange2 Is Nothing Then
        End If
        
        If srcRange3 Is Nothing Then
        End If
        
        If srcRange4 Is Nothing Then
            Entire.Row.Delete
        End If
                   
        On Error GoTo 0
               
                        
        Range(ActiveCell, Cells(i, 256)).Select
        
        Selection.Cut
        
        Cells(i, 18).Select
        
        ActiveSheet.Paste
    
        i = i + 1
    
    End If

 Loop

End Sub
Wenn ich nur nach einem Wert z.B. "P/P" suche, klappt das. Ich habe da einen Denkfehler. Könnt ihr mir bei der Passage helfen? Wenn der beim ersten bereits was findet, sollen die nächsten 3 Suchen übersprungen werden. ElseIf nimmt er hier aber leider nicht bzw ich setze es falsch ein.
        Dim srcRange1 As Range
        Dim srcRange2 As Range
        Dim srcRange3 As Range
        Dim srcRange4 As Range
        
        Range(Cells(i, 18), Cells(i, 256)).Select
        
        On Error Resume Next
        Set srcRange1 = Selection.Find(What:="DFC", After:=ActiveCell, Lookat:=xlWhole)
        Set srcRange2 = Selection.Find(What:="F/C", After:=ActiveCell, Lookat:=xlWhole)
        Set srcRange3 = Selection.Find(What:="P/P", After:=ActiveCell, Lookat:=xlWhole)
        Set srcRange4 = Selection.Find(What:="T/P", After:=ActiveCell, Lookat:=xlWhole)
        
        
        If srcRange1 Is Nothing Then
        End If
        
        If srcRange2 Is Nothing Then
        End If
        
        If srcRange3 Is Nothing Then
        End If
        
        If srcRange4 Is Nothing Then
            Entire.Row.Delete
        End If
                   
        On Error GoTo 0 
Danke und Gruß,

Manuel


  

Betrifft: AW: eine kleine Beispieldatei durchsuchen ... von: Manuel Damerow
Geschrieben am: 23.08.2016 16:27:38

Hi,

habs hinbekommen:


Sub Korrektur()
'Das Makro findet fehlerhafte Zeilen und korrigiert bzw. löscht diese

'letzte Zeile anhand Spalte A bestimmen
Dim letzteZeile As Long
 letzteZeile = Sheets("Einlesen").Range("A65536").End(xlUp).Row

'i = Zeile. Suchen ab Zeile 2
 Dim i As Integer
 i = 2

'Suchen von bis
 Do While i < letzteZeile
    'Prüfen ob DFC etc. in Spalte R stehen, wenn ja nächste Zeile  prüfen, wenn nein suchen und  _
korrigieren
    If Sheets("Einlesen").Cells(i, 18) = "DFC" Then
           i = i + 1
       ElseIf Sheets("Einlesen").Cells(i, 18) = "F/C" Then
               i = i + 1
           ElseIf Sheets("Einlesen").Cells(i, 18) = "P/P" Then
                   i = i + 1
               ElseIf Sheets("Einlesen").Cells(i, 18) = "T/P" Then
                       i = i + 1
    Else
    'Korrektur wenn Prüfung fehlgeschlagen
        'Zeile von Spalte R bis IV markieren
        Range(Cells(i, 18), Cells(i, 256)).Select
        
        'Suchen definieren
        Dim srcRange1 As Range
        Dim srcRange2 As Range
        Dim srcRange3 As Range
        Dim srcRange4 As Range
        
        On Error Resume Next
        Set srcRange1 = Selection.Find(What:="DFC", After:=ActiveCell, Lookat:=xlWhole)
        Set srcRange2 = Selection.Find(What:="F/C", After:=ActiveCell, Lookat:=xlWhole)
        Set srcRange3 = Selection.Find(What:="P/P", After:=ActiveCell, Lookat:=xlWhole)
        Set srcRange4 = Selection.Find(What:="T/P", After:=ActiveCell, Lookat:=xlWhole)
        
        'Wenn DFC gefunden wird, dann korrigieren, sonst F/C prüfen etc...
        If Not srcRange1 Is Nothing Then
            srcRange1.Activate
            Range(ActiveCell, Cells(i, 256)).Select
            Selection.Cut
            Cells(i, 18).Select
            ActiveSheet.Paste
            i = i + 1
            
                ElseIf Not srcRange2 Is Nothing Then
                    srcRange2.Activate
                    Range(ActiveCell, Cells(i, 256)).Select
                    Selection.Cut
                    Cells(i, 18).Select
                    ActiveSheet.Paste
                    i = i + 1
                    
                    ElseIf Not srcRange3 Is Nothing Then
                        srcRange3.Activate
                        Range(ActiveCell, Cells(i, 256)).Select
                        Selection.Cut
                        Cells(i, 18).Select
                        ActiveSheet.Paste
                        i = i + 1
                            
                            ElseIf Not srcRange4 Is Nothing Then
                                srcRange4.Activate
                                Range(ActiveCell, Cells(i, 256)).Select
                                Selection.Cut
                                Cells(i, 18).Select
                                ActiveSheet.Paste
                                i = i + 1
                                    
                                    'Wenn nichts gefunden wird, dann Zeile löschen
                                    Else
                                    Rows(i).EntireRow.Delete
                                    
        End If
        On Error GoTo 0
    End If
    'wiederholen bis zur letzten Zeile
    Loop
End Sub

Falls Euch Verbesserungen auffallen gerne.

Gruß,

Manuel


Beiträge aus den Excel-Beispielen zum Thema "Spalten + Zeilen nach Werten aus Liste durchsuchen"