Löschen mit berücksichtigung einer zweiten Datei

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
teste mal:

Option Explicit

Public Sub Delete_NO()
    Dim objWorkbook As Workbook, objWorksheet As Worksheet
    Dim objCell As Range
    Dim lngRow As Long
    Dim blnFound As Boolean
    For Each objWorkbook In Workbooks
        If objWorkbook.Name = "Itemnumber.xlsx" Then
            blnFound = True
            Exit For
        End If
    Next
    If Not blnFound Then
        Call MsgBox("Arbeitsmappe ''Itemnumber'' ist nicht geöffnet.", vbExclamation, "Hinweis")
    Else
        Application.ScreenUpdating = False
        Set objWorksheet = objWorkbook.Worksheets("Quiltlines (2ND)")
        With Worksheets("Inventory table (2ND)")
            For lngRow = .Cells(.Rows.Count, 5).End(xlUp).Row To 2 Step -1
                If .Cells(lngRow, 5).Value = "No" Then
                    Set objCell = objWorksheet.Columns(2).Find( _
                        What:=.Cells(lngRow, 1).Value, LookIn:=xlValues, LookAt:=xlWhole)
                    If objCell Is Nothing Then
                        Call .Rows(lngRow).Delete
                        Set objCell = Nothing
                    End If
                End If
            Next
        End With
        Set objWorkbook = Nothing
        Set objWorksheet = Nothing
        Application.ScreenUpdating = True
    End If
End Sub

Gruß
Nepumuk

Hallo,
dann teste mal:

Option Explicit

Public Sub Delete_NO()
    Dim objWorkbook As Workbook, objWorksheet As Worksheet
    Dim objCell As Range
    Dim lngRow As Long
    Dim blnFound As Boolean
    'Bildeschirmaktualisierung ausschalten
    Application.ScreenUpdating = False
    'Suche nach Mappe Itemnumber
    For Each objWorkbook In Workbooks
        If objWorkbook.Name = "Itemnumber.xlsx" Then
            blnFound = True
            Exit For
        End If
    Next
    'Wenn die Mappe nicht gefunden wurde öffnen
    If Not blnFound Then Set objWorkbook = Workbooks.Open( _
        Filename:=ThisWorkbook.Path & "\Itemnumber.xlsx")
    'Verweis auf die Tabelle setzen
    Set objWorksheet = objWorkbook.Worksheets("Quiltlines (2ND)")
    With ThisWorkbook.Worksheets("Inventory table (2ND)")
        'Schleife über alle Zeilen in Spalte E von unten nach oben
        For lngRow = .Cells(.Rows.Count, 5).End(xlUp).Row To 2 Step -1
            'Wenn in der Zelle eine No steht
            If .Cells(lngRow, 5).Value = "No" Then
                'Suche in Mappe Itemnumber nach der Nummer
                Set objCell = objWorksheet.Columns(2).Find( _
                    What:=.Cells(lngRow, 1).Value, LookIn:=xlValues, LookAt:=xlWhole)
                'Wenn die Nummer nicht gefunden wurde
                If objCell Is Nothing Then
                    'Lösche die Zeile
                    Call .Rows(lngRow).Delete
                    'Objekt zurücksetzen
                    Set objCell = Nothing
                End If
            End If
        Next
    End With
    'Wenn die Mappe Itemnumber automatisch geöffnet wurde diese wieder schließen
    If Not blnFound Then Call objWorkbook.Close(SaveChanges:=False)
    'Objkete zurücksetzen
    Set objWorkbook = Nothing
    Set objWorksheet = Nothing
    'Bildeschirmaktualisierung einschalten
    Application.ScreenUpdating = True
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

Löschen mit berücksichtigung einer zweiten Datei

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread