Dim rngCell() As Range
Dim strWorkbook() As String
Dim strWorksheet() As String
Dim Arbeitsmappe1, Arbeitsmappe2 As String
Dim a, b, Zeile1, Zeile2, Zeile2safe, Letztezeile1, Letztezeile2 As Integer
Dim Suchwert, Spalte1, Spalte2 As String
Private Sub cmdOK_Click()
Dim bk As Workbook
Dim sh As Worksheet
Dim iCnt As Integer
Dim ch As Range
ReDim rngCell(Application.Workbooks.Count)
ReDim strWorkbook(Application.Workbooks.Count)
ReDim strWorksheet(Application.Workbooks.Count)
For Each bk In Application.Workbooks
iCnt = iCnt + 1
strWorkbook(iCnt) = bk.Name
Set sh = bk.ActiveSheet
strWorksheet(iCnt) = sh.Name
rngCell(iCnt) = rng.Name
rngCell = rng.Name
If bk.Name <> ActiveWorkbook.Name Then
Debug.Print bk.Name
End If
Next
Arbeitsmappe1 = strWorkbook(iCnt)
Call Suchen_in_zwei_Dateienv2
Unload Me
End Sub
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim rng As Range
Dim bk As Workbook
Set bk = ActiveWorkbook
Set rng = Application.ActiveCell
Me.lblZelle.Caption = "[" & bk.Name & "]" & rng.Worksheet.Name & "!" & rng.Address
End Sub
Private Sub Suchen_in_zwei_Dateienv2()
Application.ScreenUpdating = False
a = 1
b = 1
Suchwert = "Platzhalter"
Windows(Arbeitsmappe1).Activate
Letztezeile1 = ActiveSheet.Cells(Rows.Count, Spalte1).End(xlUp).Row
Windows(Arbeitsmappe2).Activate
Letztezeile2 = ActiveSheet.Cells(Rows.Count, Spalte2).End(xlUp).Row
a = Zeile1
Do While a > Letztezeile1 = False
Windows(Arbeitsmappe1).Activate
Suchwert = Range(Spalte1 & Zeile1).Value
b = Zeile2safe
Zeile2 = Zeile2safe
Do While b > Letztezeile2 = False
Windows(Arbeitsmappe2).Activate
If Suchwert = Range(Spalte2 & Zeile2).Value Then
Range(Spalte2 & Zeile2).Interior.Color = vbRed
End If
Zeile2 = Zeile2 + 1
b = b + 1
Loop
Zeile1 = Zeile1 + 1
a = a + 1
Loop
End Sub