Option Explicit
'Verwaltuns-Struktur Spalten
Type my_SpalteVerwaltung_typ
s_SPName As String
b_vorh As Boolean
End Type
'**************************************************************
Sub SpaltenKontrollieren()
'**************************************************************
->Definition, welche Zeile die Spaltennamen enthält
Const c_ZeileSPNamen = 1
Dim wb As Workbook, ws As Worksheet
->Verwaltung der Ist-Spalten
Dim f_ist() As my_SpalteVerwaltung_typ, f_ist_cnt As Long
->Verwaltung der Soll-Spalten
Dim f_soll() As my_SpalteVerwaltung_typ, f_soll_cnt As Long
->Definition der Soll-Spaltennamen (hier 7)
ReDim f_soll(1 To 7)
f_soll(1).s_SPName = Spalte1
f_soll(2).s_SPName = Spalte2
f_soll(3).s_SPName = Spalte3
f_soll(4).s_SPName = Spalte4
f_soll(5).s_SPName = Spalte5
f_soll(6).s_SPName = Spalte6
f_soll(7).s_SPName = Spalte7
f_soll_cnt = 7
Set wb = ActiveWorkbook
Set ws = ActiveSheet
->prüfen, ob aktives Blatt Worksheet
If ws.Type = xlWorksheet Then
->Arbeitsschleife
Call Spaltenbearbeitung( _
wb, ws, f_soll(), f_soll_cnt, f_ist, f_ist_cnt, c_ZeileSPNamen)
Else
MsgBox (aktives Blatt ist kein Worksheet.)
End If
Aufraeumen:
On Error Resume Next
Set wb = Nothing: Set ws = Nothing
On Error GoTo 0
End Sub
'**************************************************************
Function Spaltenbearbeitung( _
wb As Workbook, ws As Worksheet, _
f_soll() As my_SpalteVerwaltung_typ, f_soll_cnt As Long, _
f_ist() As my_SpalteVerwaltung_typ, f_ist_cnt As Long, _
l_zeile As Long)
'**************************************************************
Dim s_Txt_ist As String, s_Txt_soll_fehlt As String
Dim s_Txt_Zusaetzlich As String, s_tmp As String
Dim b_Mld_NurEinmal As Boolean, x As Long
Dim s_Input As String, l_Input As Long, b_EingabeUnzul As Boolean
Dim l_SpalteMax As Long, ret As Integer
->Endlosschleife bis Abbruch
Do
->vorhandene Spaltenüberschriften feststellen
Call Spalten_IstFeststellen(ws, f_ist, f_ist_cnt, l_zeile, l_SpalteMax)
->Abgleich mit den Soll-Spalten und Meldungstext-Aufbereitung
Call AbgleichIstSoll(f_ist, f_ist_cnt, f_soll, f_soll_cnt, _
s_Txt_ist, s_Txt_soll_fehlt, s_Txt_Zusaetzlich)
If Not b_Mld_NurEinmal Then
->diese Meldung nur beim ersten Durchlauf
b_Mld_NurEinmal = True
MsgBox (s_Txt_soll_fehlt)->Meldung der fehlenden Soll-Spalten
MsgBox (s_Txt_Zusaetzlich)->Meldung zusätzlicher Spalten
End If
->Meldung der vorhanden Spalten und Lösch-Abfrage
s_Input = InputBox( _
s_Txt_ist & vbLf & vbLf & _
Zum Löschen einer Spalte geben Sie bitte die SPNr. ein., _
Spalten löschen, )
If s_Input = Then Exit Do->Abbruch oder keine Eingabe
->Eingabe auf Zeilennummer prüfen
b_EingabeUnzul = True
For x = 1 To Len(s_Input)
s_tmp = Mid(s_Input, x, 1)
Select Case s_tmp
Case 0 To 9
Case Else
b_EingabeUnzul = False
Exit For
End Select
Next
If Not b_EingabeUnzul Then
MsgBox (Bitte eine zulässige Spaltennummer eingeben.)
Else
->String in eine Zahl umwandeln
l_Input = s_Input
->Pruefen, ob es eine Zulässige Spaltennummer ist
If (1 <= l_Input) And (l_Input <= l_SpalteMax) Then
ret = MsgBox( _
Wollen Sie wirklich Spalte & l_Input & löschen?, _
vbQuestion + vbDefaultButton2 + vbYesNo)
If ret = vbYes Then
->Spalte löschen
ws.Columns(l_Input).Delete
End If
Else
MsgBox (Spaltennummer & l_Input & ist unzulässig.)
End If
End If
Loop
End Function
'**************************************************************
Function Spalten_IstFeststellen(ws As Worksheet, _
f_ist() As my_SpalteVerwaltung_typ, f_ist_cnt As Long, _
l_zeile As Long, l_SpalteMax As Long)
'**************************************************************
Dim x As Long
->letzte Überschriftszeile feststellen
l_SpalteMax = ws.Cells(l_zeile, ws.Columns.Count).End(xlToLeft).Column
->Feld initialisieren
ReDim f_ist(1 To 1): f_ist_cnt = 0
f_ist(1).b_vorh = False
For x = 1 To l_SpalteMax
->neuen Eintrag bereitstellen
f_ist_cnt = f_ist_cnt + 1
ReDim Preserve f_ist(1 To f_ist_cnt)
->Spaltennamen eintragen
f_ist(x).s_SPName = ws.Cells(l_zeile, x)
Next x
End Function
'**************************************************************
Function AbgleichIstSoll( _
f_ist() As my_SpalteVerwaltung_typ, f_ist_cnt As Long, _
f_soll() As my_SpalteVerwaltung_typ, f_soll_cnt As Long, _
s_Txt_ist As String, s_Txt_soll_fehlt As String, _
s_Txt_Zusaetzlich As String)
'**************************************************************
Dim i As Long, s As Long, b_gefunden As Boolean
->Ist / Soll abgleichen
For i = 1 To f_ist_cnt
For s = 1 To f_soll_cnt
If f_ist(i).s_SPName = f_soll(s).s_SPName Then
f_ist(i).b_vorh = True->Kennung Sollvorgabe
f_soll(s).b_vorh = True->Kennung ist vorhanden
Exit For
End If
Next s
Next i
->s_Txt_soll_fehlt aufbereiten
s_Txt_soll_fehlt =
For s = 1 To f_soll_cnt
If f_soll(s).b_vorh = False Then
s_Txt_soll_fehlt = s_Txt_soll_fehlt & vbLf & f_soll(s).s_SPName
End If
Next s
If s_Txt_soll_fehlt = Then
s_Txt_soll_fehlt = Es sind alle Soll-Spalten vorhanden.
End If
s_Txt_soll_fehlt = fehlende Soll-Spalten: & vbLf & s_Txt_soll_fehlt
->s_Txt_Zusaetzlich aufbereiten
s_Txt_Zusaetzlich =
For i = 1 To f_ist_cnt
If f_ist(i).b_vorh = False Then
s_Txt_Zusaetzlich = s_Txt_Zusaetzlich & vbLf & f_ist(i).s_SPName
End If
Next i
If s_Txt_Zusaetzlich = Then
s_Txt_Zusaetzlich = Es sind keine zusätzlichen Spalten vorhanden.
End If
s_Txt_Zusaetzlich = zusätzliche Spalten: & vbLf & s_Txt_Zusaetzlich
->s_Txt_ist aufbereiten
s_Txt_ist =
For i = 1 To f_ist_cnt
s_Txt_ist = s_Txt_ist & vbLf & Format(i, ##0) & ___ & f_ist(i).s_SPName
Next i
s_Txt_ist = vorhandene Spalten: & vbLf & vbLf & SPNr. & s_Txt_ist
End Function
