Excel-Datein Zeile für Zeile vergleichen
19.10.2017 18:57:16
Dominik
ich habe folgenden Code geschrieben:
Sub MontageanweisungErstellen()
Dim wrbZiel As Workbook
Dim intZeileFilterTabelle As Integer
Dim intZeileMontageanleitung As Integer
Dim intZielSchild As Integer
Dim intQuelleSchild As Integer
Dim strMaschinenTyp As String
Dim intSpalteMaschinenTyp As Integer
Dim strSpeicherPfad As String
strSpeicherPfad = "C:\Users\Dominik\Desktop\Test\" 'Hier Speicherpfad eintragen
'Application.ScreenUpdating = False '"Flackern" beim ausführen unterdrücken
If Dir(strSpeicherPfad & "Montageanweisung.xls") "" Then
Set wrbZiel = Workbooks.Open(strSpeicherPfad & "Montageanweisung.xls")
m_strMsgBoxBezeichnung = p_cstrAppTitel 'in dieser Variablen steht ein String den ich _
deglariert habe
intZeileFilterTabelle = p_cintStartZeile '=3
intZeileMontageanleitung = p_cintStartzeileMontageanweisung '=17
ThisWorkbook.Activate
'Löscht alle Zeilen mit Inhalt der nicht benötigt wird (Wichtig Excel-Listen müssen 1 _
zu 1 übereinstimmen!)
Do While Tabelle1.Cells(intZeileFilterTabelle, 4) ""
Workbooks("Montageanweisung.xls").Activate
intZielSchild = Workbooks("Montageanweisung.xls").Sheets("Montageanweisung"). _
Cells(intZeileMontageanleitung, 1) 'Nummer aus Ziel-Datei
ThisWorkbook.Activate
intQuelleSchild = Tabelle1.Cells(intZeileFilterTabelle, 4) 'Nummer aus Ziel- _
Datei
If intZielSchild = intQuelleSchild Then
If Tabelle1.Rows(intZeileFilterTabelle).Hidden = True Then
Workbooks(p_cstrMontageanweisungName.xls).Activate
Workbooks(p_cstrMontageanweisungName.xls).Sheets("Montageanweisung"). _
Cells(intZeileMontageanleitung, 1).EntireRow.Delete
intZeileMontageanleitung = intZeileMontageanleitung - 1
End If
Else
intZeileFilterTabelle = intZeileFilterTabelle - 1
intQuelleSchild = Tabelle1.Cells(intZeileFilterTabelle, 4)
MsgBox "Die Reihenfolge in der Excel-Listen stimmt nicht überein. Bitte _
stellen Sie sicher, dass diese Reihenfolge stimmt. Abbruch in Zeile: " & intZeileFilterTabelle & " bei Schild: " & intQuelleSchild & " Das Programm wird jetzt abgebrochen. Wiederholen Sie den vorgang nach der Überarbeitung!", vbCritical, m_strMsgBoxBezeichnung
End
End If
intZeileMontageanleitung = intZeileMontageanleitung + 1
Loop
'Speichern der Montageanweisung
Workbooks("Montageanweisung.xls").Activate
Workbooks("Montageanweisung.xls").Save
Workbooks("Montageanweisung.xls").Close
MsgBox "Montageanleitung wurde erstellt.", vbInformation, m_strMsgBoxBezeichnung
Else
MsgBox "Bitte zuerst einen komplette Montageanweisung über Tool in das entsprechende _
Verzeichnis exportieren.", vbCritical, m_strMsgBoxBezeichnung
End If
'Application.ScreenUpdating = True
End Sub
Dieser soll dafür sorgen, dass zwei Excel-Dateien miteinandern verglichen werden. In der ersten _
Datei kann ich Filtern. Dadurch wähle ich sozusagen aus welche Einträge in der Montageanweisung _ später noch vorhanden sein sollen. Alle einträge die nicht benötigt werden, werden durch löschen der Zeile entfernt. Dies funktioniert auch einwandfrei. Mich stört nun aber noch, dass ich durch das hin un her Schalten zwischen den beiden Excel-Dateien ein "flackern" erzeuge. Ich dachte eigentlich ich könnte dies mit
'Application.ScreenUpdating = False
unterdrücken. Das funktioniert soweit auch und der Code ist spührbar schneller. Leider _
funktioniert das Löschen der Zeilen in der Montageanweisung dann aber nicht richtig. Die Bilder _
die in den Zellen sind werden dann nur klein gedrückt und nicht wie zuvor mit der Zeile gelö _
scht. Gibt es eine bessere Methode zwischen den beiden Arbeitsmappen hin und her zuschalten (im Hintergrund) als
.Activate
Ich wäre euch sehr dankbar für Hilfe.
Gruß
Dominik
Anzeige