Kommentare
19.07.2009 10:00:40
ransi
HAllo Jörg
Gib mir doch mal 'ne ungefähre Vorstellung: Wie lange sitzt man als Excelprofi an so einer Lösung...
Keine Ahnung wie lange ein Profi daransitzt, bin keiner, von daher kann ich da auch nur raten.
Ich hab ca 1 stunde gebraucht. Allerdings ohne vernünftige Fehlerroutinen.
Die dauern erfahrungsgemäß immer am längsten.
Wenn der "Fahrplan" feststeht, ist soein Code recht schnell geschrieben.
Defekte oder nicht vorhandene Verweise können auch schuld sein das dein Code nicht rund läuft.
Hab die Überprüfung mal mit reingehäkelt.
Ausserdem das Ganze noch ein wenig kommentiert.
Option Explicit
Private Sub CommandButton1_Click()
Dim newApp As Application
Dim dlg As FileDialog
Dim c As Object 'As VBComponent
Dim wb(1 To 2) As Workbook
Dim L As Long 'Zähler
Dim Z As Long 'Zähler
Dim I As Integer 'Zähler
Dim str_Modul As String 'Code im CodeModul
Dim Arr As Variant 'Code gesplittet nach vbcrlf
Dim strLine As String 'Line
Dim Verweis As Object 'As Reference
Dim Dic1 As Object 'As Dictionary
Dim Dic2 As Object 'As Dictionary
Dim K 'As Dictionary.Key
Set Dic1 = CreateObject("Scripting.Dictionary")
Set Dic2 = CreateObject("Scripting.Dictionary")
Set newApp = CreateObject("Excel.Application")
With newApp
.Visible = False
.EnableEvents = False
Set dlg = Application.FileDialog(msoFileDialogOpen)
If dlg.Show = -1 Then 'Kein Abbrechen oder Schließkreuz
Set wb(1) = newApp.Workbooks.Open(dlg.SelectedItems(1))
Else: GoTo raus
End If
Set dlg = Application.FileDialog(msoFileDialogOpen)
If dlg.Show = -1 Then
Set wb(2) = newApp.Workbooks.Open(dlg.SelectedItems(1))
Else: GoTo raus
End If
For I = 1 To 2
If wb(I).VBProject.Protection = False Then 'VBA_Projct ist ungeschützt
Z = 0
For Each Verweis In wb(I).VBProject.References 'vorhandene Verweise auslesen
Z = Z + 1
If I = 1 Then 'Für die erste Datei
Dic1(Verweis.Description) = Verweis.IsBroken 'Verweis ins Dictionary
Cells(Z, 1) = Verweis.Description 'Verweis ausgeben
Cells(Z, 2) = Verweis.IsBroken 'Schauen ob der Verweis ungültig ist
Else: 'Für die zweite Datei
Dic2(Verweis.Description) = Verweis.IsBroken
Cells(Z, 3) = Verweis.Description
Cells(Z, 4) = Verweis.IsBroken
End If
Next
For Each c In wb(I).VBProject.VBComponents 'Schleife über jede VBComponent
With c.CodeModule
If .countoflines > 0 Then 'Schauen ob da was drin steht
str_Modul = .Lines(1, .countoflines) 'der ganze Code im CodeModul
str_Modul = Replace(str_Modul, "_" & vbCrLf, "") 'Mit " _" getrennte Zeilen zusammnfügen
Arr = Split(str_Modul, vbCrLf) 'Den Code in Zeilen aufteilen
For L = LBound(Arr) To UBound(Arr) 'die einzelnen Zeilen abklappern
strLine = WorksheetFunction.Trim(Arr(L))
If strLine <> "" Then 'Schauen ob in der Zeile was drin steht
Select Case I 'Für die erste Datei
Case 1
Dic1(strLine) = c.Name 'Die Zeile in ein Dictionary aufnehmen
Z = Z + 1
Cells(Z, 1) = c.Name 'Das Modul in der die Zeile steht
Cells(Z, 2) = strLine 'Die eigentliche Zeile
Case 2 'Für die zweite Datei
Dic2(strLine) = c.Name 'Die Zeile in ein Dictionary aufnehmen
Z = Z + 1
Cells(Z, 3) = c.Name
Cells(Z, 4) = strLine
End Select
End If
Next
End If
End With
Next
Else:
MsgBox "Das VBA-Project ist geschützt." & vbCrLf & "Bitte den Schutz aufheben und nochmal starten."
GoTo raus
End If
Next
End With
'Unterschiede rausarbeiten und listen
Z = 1
Cells(1, 5) = "in Datei 1 aber nicht in Datei 2"
Cells(1, 7) = "in Datei 2 aber nicht in Datei 1"
For Each K In Dic1.keys
If Not Dic2.exists(K) Then
Z = Z + 1
Cells(Z, 5) = Dic1(K)
Cells(Z, 6) = K
End If
Next
Z = 1
For Each K In Dic2.keys
If Not Dic1.exists(K) Then
Z = Z + 1
Cells(Z, 7) = Dic2(K)
Cells(Z, 8) = K
End If
Next
'Aufräumen
Do Until newApp.Workbooks.Count = 0
DoEvents
If Not wb(1) Is Nothing Then wb(1).Close False
If Not wb(2) Is Nothing Then wb(2).Close False
Loop
newApp.Quit
Exit Sub
raus:
Do Until newApp.Workbooks.Count = 0
DoEvents
If Not wb(1) Is Nothing Then wb(1).Close False
If Not wb(2) Is Nothing Then wb(2).Close False
Loop
newApp.Quit
End Sub
ransi