AW: Makro für Tabellenvergleich
01.02.2018 15:44:01
Peter(silie)
Hallo,
hier deine Mappe: https://www.herber.de/bbs/user/119474.xlsm
Beim Fettgedruckten musst du noch die Pfade anpassen
Private Sub OpenTables()
Dim p1 As String, p2 As String
p1 = "Pfad"
p2 = "Pfad"
If Not FileExists(p1) Or Not FileExists(p2) Then Exit Sub
Dim a As Workbook
Set Db1.BaseObject = Workbooks.Open(p1)
Set Db2.BaseObject = Workbooks.Open(p2)
Set Db1.Table = Db1.BaseObject.Sheets(1)
Set Db2.Table = Db2.BaseObject.Sheets(1)
End Sub
Wenn du alle Werte unter dem Suchbegriff haben willst, dann passe die Variablen in Base und in der Database Klasse an, damit sie ein Array darstellen usw.
Kurz um: Du musst noch Feintuning bei dem Ding machen
Hier nur Code:
Base Modul:
Option Explicit
Public Type db
BaseObject As Workbook
Table As Worksheet
SN_Col As String
SN2_Col As String
SNBR_Col As String
IMEI_Col As String
SN As String
SN2 As String
SNBR As String
IMEI As String
End Type
DB_Operator Modul:
Option Explicit
Private Db1 As Database
Private Db2 As Database
Public Sub CheckMyTables()
Set Db1 = New Database
Set Db2 = New Database
OpenTables
Get_SNBR_IMEI
Get_SN
CheckValues
CloseTables
End Sub
Private Sub OpenTables()
Dim p1 As String, p2 As String
p1 = "Pfad"
p2 = "Pfad"
If Not FileExists(p1) Or Not FileExists(p2) Then Exit Sub
Dim a As Workbook
Set Db1.BaseObject = Workbooks.Open(p1)
Set Db2.BaseObject = Workbooks.Open(p2)
Set Db1.Table = Db1.BaseObject.Sheets(1)
Set Db2.Table = Db2.BaseObject.Sheets(1)
End Sub
Private Sub CloseTables()
If Not Db1.BaseObject Is Nothing Then
Db1.BaseObject.Close False
Set Db1 = Nothing
End If
If Not Db2.BaseObject Is Nothing Then
Db2.BaseObject.Close False
Set Db2 = Nothing
End If
End Sub
Private Function FileExists(ByVal Path_ As String) As Boolean
If Dir(Path_, vbDirectory) vbNullString Then FileExists = True
End Function
Private Sub Get_SNBR_IMEI()
Dim lRow As Long, lCol As Long
Dim i As Long, area As Variant
Dim j As Long
With Db1.Table
lCol = .UsedRange.Columns.Count
For i = 1 To lCol
lRow = .Cells(.Rows.Count, i).End(xlUp).Row
area = .Range(.Cells(1, i), .Cells(lRow, i)).Value
If Db1.SNBR_Col = vbNullString Then
j = SearchID(area, "Serial Nbr.")
If j > 0 Then
Db1.SNBR = .Cells(j + 1, i)
Db1.SNBR_Col = " Row: " & j & " Column: " & i
End If
End If
If Db1.IMEI_Col = vbNullString Then
j = SearchID(area, "IMEI")
If j > 0 Then
Db1.IMEI = .Cells(j + 1, i)
Db1.IMEI_Col = " Row: " & j & " Column: " & i
End If
End If
If Db1.SNBR_Col vbNullString And Db1.IMEI_Col vbNullString Then Exit For
Next i
End With
End Sub
Private Sub Get_SN()
Dim lRow As Long, lCol As Long
Dim i As Long, area As Variant
Dim j As Long
With Db2.Table
lCol = .UsedRange.Columns.Count
For i = 1 To lCol
lRow = .Cells(.Rows.Count, i).End(xlUp).Row
area = .Range(.Cells(1, i), .Cells(lRow, i)).Value
If Db2.SN_Col = vbNullString Then
j = SearchID(area, "SN")
If j > 0 Then
Db2.SN = Cells(j + 1, i).Value
Db2.SN_Col = " Row: " & j & " Column: " & i
End If
End If
If Db2.SN2_Col = vbNullString Then
j = SearchID(area, "SN2")
If j > 0 Then
Db2.SN2 = Cells(j + 1, i).Value
Db2.SN2_Col = " Row: " & j & " Column: " & i
End If
End If
If Db2.SN_Col vbNullString And Db2.SN2_Col vbNullString Then Exit For
Next i
End With
End Sub
Private Function SearchID(ByVal SearchArea As Variant, ByVal ValueToFind As String) As Long
If Not VBA.IsError(Application.Match(ValueToFind, SearchArea, 0)) Then
SearchID = Application.Match(ValueToFind, SearchArea, 0)
End If
End Function
Private Sub CheckValues()
If Db1.IMEI Db1.SN Then MsgBox Db2.IMEI & Db2.IMEI_Col & vbCrLf & Db2.SN & Db2.SN_Col
If Db1.SNBR Db1.SN2 Then MsgBox Db2.SNBR & Db2.SNBR_Col & vbCrLf & Db2.SN2 & Db2.SN2_Col
End Sub
Database Klasse:
Option Explicit
Private db As Base.db
Public Property Set BaseObject(ByRef this_ As Workbook)
Set db.BaseObject = this_
End Property
Public Property Get BaseObject() As Workbook
Set BaseObject = db.BaseObject
End Property
Public Property Set Table(ByRef this_ As Worksheet)
Set db.Table = this_
End Property
Public Property Get Table() As Worksheet
Set Table = db.Table
End Property
Public Property Let SN_Col(ByVal value_ As String)
db.SN_Col = value_
End Property
Public Property Get SN_Col() As String
SN_Col = db.SN_Col
End Property
Public Property Let SN2_Col(ByVal value_ As String)
db.SN2_Col = value_
End Property
Public Property Get SN2_Col() As String
SN2_Col = db.SN2_Col
End Property
Public Property Let SNBR_Col(ByVal value_ As String)
db.SNBR_Col = value_
End Property
Public Property Get SNBR_Col() As String
SNBR_Col = db.SNBR_Col
End Property
Public Property Let IMEI_Col(ByVal value_ As String)
db.IMEI_Col = value_
End Property
Public Property Get IMEI_Col() As String
IMEI_Col = db.IMEI_Col
End Property
Public Property Get SN() As String
SN = db.SN
End Property
Public Property Get SN2() As String
SN2 = db.SN2
End Property
Public Property Get SNBR() As String
SNBR = db.SNBR
End Property
Public Property Get IMEI() As String
IMEI = db.IMEI
End Property
Public Property Let SN(ByVal value_ As String)
db.SN = value_
End Property
Public Property Let SN2(ByVal value_ As String)
db.SN2 = value_
End Property
Public Property Let SNBR(ByVal value_ As String)
db.SNBR = value_
End Property
Public Property Let IMEI(ByVal value_ As String)
db.IMEI = value_
End Property