Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1400to1404
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA-Prüfung nach vergessenen Zellen

VBA-Prüfung nach vergessenen Zellen
08.01.2015 10:55:34
Sandra
Hallo zusammen,
zuerst einmal "EIN FROHES UND GESUNDES NEUS JAHR!!!"....
Ich bin schon wieder einmal dringend auf Eure Hilfe angewiesen.
Dank Euch habe ich folgendes Makro:
Option Explicit
Sub Maengelliste_SKH()
Dim oXlSM As Workbook, oXML As Workbook
Dim nIndexXLSM, nIndexXML, MaxRow As Long, nIndex As Long
Dim rngXLSM As Range, rngXML As Range, ArrayXLSM
Dim strFehler As String
Dim ArrayQuelle, ArrayZiel
Const sListZeichen$ = "• "
'hier stehen die Überschriften, nach denen gesucht wird
'Wichtig! Die Reihenfolge muss bei beiden identisch sein
ArrayQuelle = Array("Betrifft", "verortete Zustandsbeschreibung", "Mangelart", "Vertragsart", " _
Gewerkegruppe", "Gewerk", "Bauteil", "Geschoss", _
"Nutzung", "Level D", "Raum", "Achse", "Foto", "Frist", "Nachfrist", "letzte Nachfrist", " _
Auftragnehmer", "betriebsrelevant", "Vorbereitung der Abnahme", _
"VL AG", "sicherheitsrelevant", "Restleistung", "Bauherr", "optisch", "Anspruch unsicher", " _
Nachweis fehlt")
ArrayZiel = Array("betrifft", "Zustandsbeschreibung", "Mangelart", "Vertragsart", " _
Gewerkegruppe", "Gewerk", "Bauteil", "Geschoss", "Nutzung", _
"Level D", "Raum", "Achse", "Foto", "Frist", "Nachfrist", "letzte Nachfrist", "Auftragnehmer", " _
betriebsrelevant", "Vorbereitung der Abnahme", _
"VL AG", "sicherheitsrelevant", "Restleistung", "Bauherr", "optisch", "Anspruch unsicher", " _
Nachweis fehlt")
'hier wird festgelegt welche Datei geöffnet werden soll und wo diese gespeichert ist
Set oXML = Workbooks.Open(Filename:= _
"\\PFAD\" & _
"0000 MUSTER\Mangelerfassung\SKH VORLAGE Zustandsbeschreibung.xml")
Set oXlSM = ThisWorkbook 'ThisWorkbook = die xlsm-Datei, in der dieser Code steht
For nIndex = LBound(ArrayQuelle) To UBound(ArrayQuelle)
With oXlSM.Sheets("Mängel vor der Abnahme") 'Name des Tabellenblattes, welches in der xlsm-  _
_
Datei benutzt wird
nIndexXLSM = Application.Match(ArrayQuelle(nIndex), .Rows(2), 0) 'sucht in der Zeile 2 _
nach den Spaltenbeschriftungen
If IsNumeric(nIndexXLSM) Then
MaxRow = .Cells(.Rows.Count, nIndexXLSM).End(xlUp).Row 'letzte Zeile in Spalte
Set rngXLSM = .Range(.Cells(3, nIndexXLSM), .Cells(MaxRow, nIndexXLSM))
If MaxRow > 3 Then
ArrayXLSM = rngXLSM
ElseIf MaxRow = 3 Then
ArrayXLSM = rngXLSM.Resize(, 2)
ReDim Preserve ArrayXLSM(1 To UBound(ArrayXLSM), 1 To 1)
End If
'Fehlermeldung die ausgegeben wird, wenn eine festgelegte Spaltenüberschrift nicht in _
der xlsm-Datei gefunden werden konnte
Else
strFehler = strFehler & sListZeichen & "Die Spalte '" & _
ArrayQuelle(nIndex) & "' wurde nicht in der Quell-Datei gefunden." & vbCr
MsgBox strFehler
Exit Sub
End If
End With
If IsArray(ArrayXLSM) Then
With oXML.Sheets("neue Zustandsbeschreibungen") 'Name des Tabellenblattes, welches in der  _
_
xml-Datei benutzt wird
nIndexXML = Application.Match(ArrayZiel(nIndex), .Rows(27), 0) 'sucht in der Zeile 27 _
nach den Spaltenbeschriftungen
If IsNumeric(nIndexXML) Then
'alle Inhalte der Zellen ab Zeile 28 werden für neue Daten gelöscht
.Range(.Cells(28, nIndexXML), .Cells(.Rows.Count, nIndexXML)).ClearContents
Set rngXML = .Cells(28, nIndexXML) 'erste Einfügezelle
rngXML.Resize(UBound(ArrayXLSM), 1) = ArrayXLSM 'Daten aus Array einfügen
Else
strFehler = strFehler & sListZeichen & "Die Spalte '" & _
ArrayZiel(nIndex) & "' wurde nicht in der Ziel-Datei gefunden." & vbCr
MsgBox strFehler
Exit Sub
End If
End With
End If
ArrayXLSM = Empty
Next nIndex
Dim Sh_neue_Zustandsbeschreibungen As Worksheet
Dim iCalc As Long
On Error GoTo ErrExit
Set Sh_neue_Zustandsbeschreibungen = Sheets("neue Zustandsbeschreibungen") 'hier wird das  _
Tabellenblatt beschrieben, wo die Leerzeilen gelöscht werden sollen
With Application
iCalc = .Calculation
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
'hier erfolgt die Abschaltung des Blattschutzes
With Sh_neue_Zustandsbeschreibungen
.Unprotect
'hier werden Zeilen die komplett leer sind gelöscht
With .UsedRange.Columns(.UsedRange.Columns.Count).Offset(0, 1)
.FormulaR1C1 = "=IF(AND(ROW()>28,RC1&RC2=""""),TRUE(),ROW())"
Sh_neue_Zustandsbeschreibungen.UsedRange.Sort .Cells(1, 1), xlAscending, , , , , , xlNo
On Error Resume Next
.SpecialCells(xlCellTypeFormulas, 4).EntireRow.Delete
On Error GoTo ErrExit
.EntireColumn.Delete
End With
'hier wird der Blattschutz wieder aktiviert
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True
End With
ErrExit:
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = iCalc
End With
Set Sh_neue_Zustandsbeschreibungen = Nothing
'hier erfolgt die Prüfung nach ggf. vergessenen Zellen
Dim zeile As Long, spalte As Long
Dim i As Integer
Dim strausgabe As String, strzelle As String, x As String
Dim wks As Worksheet
Dim check As Boolean
Set wks = Sheets(1)
Dim spalten()
Dim spaltennamen()
Dim spaltenausgabe()
x = ""
spalten() = Array(1, 2, 9, 10, 11, 12, 13, 14, 16, 19)
spaltennamen() = Array( _
"In der Spalte Bauteil (A)", _
"In der Spalte Geschoss (B)", _
"In der Spalte Betrifft (I)", _
"In der Spalte Zustandsbeschreibung (J)", _
"In der Spalte Mangelart (K)", _
"In der Spalte Vertragsart(L)", _
"In der Spalte Gewerkegruppe(M)", _
"In der Spalte Gewerk(O)", _
"In der Spalte Frist(Q)", _
"In der Spalte Auftragnehmer(T)")
spaltenausgabe() = Array(x, x, x, x, x, x, x, x, x, x)
For i = 0 To UBound(spalten())
spaltenausgabe(i) = spaltennamen(i) & " in den Zeilen: "
Next i
With wks
For zeile = 28 To 500
If .Cells(zeile, 2).Value  "" Then
For i = 0 To UBound(spalten())
On Error GoTo schleife
If Cells(zeile, spalten(i)).Value = 0 Then
schleife:
spaltenausgabe(i) = spaltenausgabe(i) & vbCrLf & zeile & ",  " & vbCrLf
check = True
End If
Next i
End If
Next zeile
End With
If check = True Then
For i = 0 To UBound(spalten())
strausgabe = strausgabe & spaltenausgabe(i) & vbCrLf
Next i
MsgBox "Fehlerhaft ausgefüllte Zellen: " & vbCrLf & vbCrLf & _
strausgabe
Exit Sub
Else
MsgBox "Es konnten keine leeren Zellen in den Spalten Bauteil (A), Geschoss (B), Betrifft ( _
I), Zustandsbeschreibung (J), Mangelart (K), Vertragsart(L), Gewerkegruppe(M), Gewerk(O), Frist(Q), und Auftragnehmer(T) gefunden werden!"
End If
'Spalte Frist = Datumsformat
Columns("O:O").Select
Selection.NumberFormat = "dd/mm/yyyy"
'speichern der xml-Datei
Dim DateiName As String
DateiName = Left(oXlSM.Name, Len(oXlSM.Name) - 5)
Dim vntFilename As Variant
vntFilename = "\\PFAD\" & DateiName & ".xml"
On Error Resume Next
Do
Err.Clear
ActiveWorkbook.SaveAs vntFilename
If Err Then
Do
vntFilename = Application.GetSaveAsFilename
Loop While vntFilename = False
End If
Loop While Err
Maengelliste_SKH_MB
End Sub
Sub Maengelliste_SKH_MB()
Dim oXlSM As Workbook, oXLSX As Workbook
Dim nIndexXLSM, nIndexXLSX, MaxRow As Long, nIndex As Long
Dim rngXLSM As Range, rngXLSX As Range, ArrayXLSM
Dim strFehler As String
Dim ArrayQuelle, ArrayZiel
Const sListZeichen$ = "• "
'hier stehen die Überschriften, nach denen gesucht wird
'Wichtig! Die Reihenfolge muss bei beiden identisch sein
ArrayQuelle = Array("Betrifft", "verortete Zustandsbeschreibung", "Gewerk", "Bauteil", " _
Geschoss", "Nutzung", "Raum", "Achse", "Frist")
ArrayZiel = Array("betrifft", "Zustandsbeschreibung", "Gewerk", "Bauteil", "Geschoss", " _
Nutzung", "Raum", "Achse", "Frist")
'hier wird festgelegt welche Datei geöffnet werden soll und wo diese gespeichert ist
Set oXLSX = Workbooks.Open(Filename:= _
"\\PFAD\SKH VORLAGE Info-Datei MB-Ergebnis.xlsx")
Set oXlSM = ThisWorkbook 'ThisWorkbook = die xlsm-Datei, in der dieser Code steht
For nIndex = LBound(ArrayQuelle) To UBound(ArrayQuelle)
With oXlSM.Sheets("Mängel vor der Abnahme") 'Name des Tabellenblattes, welches in der xlsm- _
Datei benutzt wird
nIndexXLSM = Application.Match(ArrayQuelle(nIndex), .Rows(2), 0) 'sucht in der Zeile 2  _
nach den Spaltenbeschriftungen
If IsNumeric(nIndexXLSM) Then
MaxRow = .Cells(.Rows.Count, nIndexXLSM).End(xlUp).Row 'letzte Zeile in Spalte
Set rngXLSM = .Range(.Cells(3, nIndexXLSM), .Cells(MaxRow, nIndexXLSM))
If MaxRow > 3 Then
ArrayXLSM = rngXLSM
ElseIf MaxRow = 3 Then
ArrayXLSM = rngXLSM.Resize(, 2)
ReDim Preserve ArrayXLSM(1 To UBound(ArrayXLSM), 1 To 1)
End If
'Fehlermeldung die ausgegeben wird, wenn eine festgelegte Spaltenüberschrift nicht  _
in der xlsm-Datei gefunden werden konnte
strFehler = strFehler & sListZeichen & "Die Spalte'" & _
ArrayQuelle(nIndex) & "' wurde nicht in der Quell-Datei gefunden" &  _
vbCr
End If
End With
If IsArray(ArrayXLSM) Then
With oXLSX.Sheets("Mängel vor der Abnahme") 'Name des Tabellenblattes, welches in der  _
xlsx-Datei benutzt wird
nIndexXLSX = Application.Match(ArrayZiel(nIndex), .Rows(2), 0) 'sucht in der Zeile  _
2 nach den Spaltenbeschriftungen
If IsNumeric(nIndexXLSX) Then
'alle Inhalte der Zellen ab Zeile 3 werden für neue Daten gelöscht
.Range(.Cells(3, nIndexXLSX), .Cells(.Rows.Count, nIndexXLSX)).ClearContents
Set rngXLSX = .Cells(3, nIndexXLSX) 'erste Einfügezelle
rngXLSX.Resize(UBound(ArrayXLSM), 1) = ArrayXLSM 'Daten aus Array einfügen
Else
strFehler = strFehler & sListZeichen & "Die Spalte'" & _
ArrayZiel(nIndex) & "' wurde nicht in der Ziel-Datei gefunden" &  _
vbCr
End If
End With
End If
ArrayXLSM = Empty
Next nIndex
oXLSX.Sheets("Mängel vor der Abnahme").Range("C1") = oXlSM.Sheets("Mängel vor der Abnahme"). _
Range("C1")
'Spalte Frist = Datumsformat
Columns("K:K").Select
Selection.NumberFormat = "dd/mm/yyyy"
'speichern der xlsx-Datei
Dim DateiName As String
DateiName = Left(oXlSM.Name, Len(oXlSM.Name) - 5)
Dim vntFilename As Variant
vntFilename = "\\PFAD\ " & DateiName & " MB" & ".xlsx"
On Error Resume Next
Do
Err.Clear
ActiveWorkbook.SaveAs vntFilename
If Err Then
Do
vntFilename = Application.GetSaveAsFilename
Loop While vntFilename = False
End If
Loop While Err
End Sub

Das anzupassen habe ich immer hinbekommen. Jetzt gibt es aber eine Änderung die ich alleine nicht hinbekomme.
Die Prüfung nach nicht ausgefüllten Zellen erfolgt nach Erstellung der XML-Datei in dieser.
Ich möchte gerne, dass erst die Prüfung (innerhalb der xlsm-Liste) erfolgt und bei Fehlerfreiheit die XML-Datei erstellt und gespeichert wird. Sollten Fehler vorhanden sein, dann soll die Erstellung der XML-Datei abgebrochen werden.
Desweiteren wäre es schön, wenn nicht nur die Msg-Box erscheint, sondern das die fehlenden Zellen farblich unterlegt werden. Ist aber kein Muss, sondern nur ein nettes Bonbon. :)
Was ich auch nicht gut finde ist dieser Teil:
'Spalte Frist = Datumsformat
Columns("O:O").Select
Selection.NumberFormat = "dd/mm/yyyy"
Geht das nicht anders? Diese Ausführung kann man nämlich sehen.
Könnt Ihr mir hierzu helfen?
Vielen Dank!
Viele Grüße
Sandra

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA-Prüfung nach vergessenen Zellen
08.01.2015 12:03:21
Rudi
Hallo,
wer soll sich da durchwühlen?
Zur letzen Frage:
Columns("O:O").NumberFormat = "dd/mm/yyyy"
Gruß
Rudi

AW: VBA-Prüfung nach vergessenen Zellen
08.01.2015 12:31:35
Sandra
Hallo Rudi.
Sorry, ich weiß immer nicht wie ich meine Fragen am Besten aufbauen soll.
Es geht um diesen Teil:

'hier erfolgt die Prüfung nach ggf. vergessenen Zellen
Dim zeile As Long, spalte As Long
Dim i As Integer
Dim strausgabe As String, strzelle As String, x As String
Dim wks As Worksheet
Dim check As Boolean
Set wks = Sheets(1)
Dim spalten()
Dim spaltennamen()
Dim spaltenausgabe()
x = ""
spalten() = Array(1, 2, 9, 10, 11, 12, 13, 14, 16, 19)
spaltennamen() = Array( _
"In der Spalte Bauteil (A)", _
"In der Spalte Geschoss (B)", _
"In der Spalte Betrifft (I)", _
"In der Spalte Zustandsbeschreibung (J)", _
"In der Spalte Mangelart (K)", _
"In der Spalte Vertragsart(L)", _
"In der Spalte Gewerkegruppe(M)", _
"In der Spalte Gewerk(O)", _
"In der Spalte Frist(Q)", _
"In der Spalte Auftragnehmer(T)")
spaltenausgabe() = Array(x, x, x, x, x, x, x, x, x, x)
For i = 0 To UBound(spalten())
spaltenausgabe(i) = spaltennamen(i) & " in den Zeilen: "
Next i
With wks
For zeile = 28 To 500
If .Cells(zeile, 2).Value  "" Then
For i = 0 To UBound(spalten())
On Error GoTo schleife
If Cells(zeile, spalten(i)).Value = 0 Then
schleife:
spaltenausgabe(i) = spaltenausgabe(i) & vbCrLf & zeile & ",  " & vbCrLf
check = True
End If
Next i
End If
Next zeile
End With
If check = True Then
For i = 0 To UBound(spalten())
strausgabe = strausgabe & spaltenausgabe(i) & vbCrLf
Next i
MsgBox "Fehlerhaft ausgefüllte Zellen: " & vbCrLf & vbCrLf & _
strausgabe
Exit Sub
Else
MsgBox "Es konnten keine leeren Zellen in den Spalten Bauteil (A), Geschoss (B), Betrifft (  _
_
I), Zustandsbeschreibung (J), Mangelart (K), Vertragsart(L), Gewerkegruppe(M), Gewerk(O), Frist( _
Q), und Auftragnehmer(T) gefunden werden!"
End If

Der Teil kommt, wenn aus der xlsm-Datei durchs Makro eine XML-Datei generiert wurde. Die Prüfung soll aber nicht in der XML-Datei, sondern bereits in der xlsm-Datei erfolgen.
Erst danach soll die XML-Datei erstellt werden und das auch nur dann wenn kein Fehler auftrat.
Noch einmal zur Erläuterung:

Sub Maengelliste_SKH()
Dim oXlSM As Workbook, oXML As Workbook
Dim nIndexXLSM, nIndexXML, MaxRow As Long, nIndex As Long
Dim rngXLSM As Range, rngXML As Range, ArrayXLSM
Dim strFehler As String
Dim ArrayQuelle, ArrayZiel
Const sListZeichen$ = "• "
'hier stehen die Überschriften, nach denen gesucht wird
'Wichtig! Die Reihenfolge muss bei beiden identisch sein
ArrayQuelle = Array("Betrifft", "verortete Zustandsbeschreibung", "Mangelart", "Vertragsart", "  _
_
Gewerkegruppe", "Gewerk", "Bauteil", "Geschoss", _
"Nutzung", "Level D", "Raum", "Achse", "Foto", "Frist", "Nachfrist", "letzte Nachfrist", " _
Auftragnehmer", "betriebsrelevant", "Vorbereitung der Abnahme", _
"VL AG", "sicherheitsrelevant", "Restleistung", "Bauherr", "optisch", "Anspruch unsicher", " _
Nachweis fehlt")
ArrayZiel = Array("betrifft", "Zustandsbeschreibung", "Mangelart", "Vertragsart", " _
Gewerkegruppe", "Gewerk", "Bauteil", "Geschoss", "Nutzung", _
"Level D", "Raum", "Achse", "Foto", "Frist", "Nachfrist", "letzte Nachfrist", "Auftragnehmer", " _
_
betriebsrelevant", "Vorbereitung der Abnahme", _
"VL AG", "sicherheitsrelevant", "Restleistung", "Bauherr", "optisch", "Anspruch unsicher", " _
Nachweis fehlt")
'hier wird festgelegt welche Datei geöffnet werden soll und wo diese gespeichert ist
Set oXML = Workbooks.Open(Filename:= _
"\\PFAD\" & _
"0000 MUSTER\Mangelerfassung\SKH VORLAGE Zustandsbeschreibung.xml")
Set oXlSM = ThisWorkbook 'ThisWorkbook = die xlsm-Datei, in der dieser Code steht
For nIndex = LBound(ArrayQuelle) To UBound(ArrayQuelle)
With oXlSM.Sheets("Mängel vor der Abnahme") 'Name des Tabellenblattes, welches in der xlsm-  _
_
_
Datei benutzt wird
nIndexXLSM = Application.Match(ArrayQuelle(nIndex), .Rows(2), 0) 'sucht in der Zeile 2 _
nach den Spaltenbeschriftungen
If IsNumeric(nIndexXLSM) Then
MaxRow = .Cells(.Rows.Count, nIndexXLSM).End(xlUp).Row 'letzte Zeile in Spalte
Set rngXLSM = .Range(.Cells(3, nIndexXLSM), .Cells(MaxRow, nIndexXLSM))
If MaxRow > 3 Then
ArrayXLSM = rngXLSM
ElseIf MaxRow = 3 Then
ArrayXLSM = rngXLSM.Resize(, 2)
ReDim Preserve ArrayXLSM(1 To UBound(ArrayXLSM), 1 To 1)
End If
'Fehlermeldung die ausgegeben wird, wenn eine festgelegte Spaltenüberschrift nicht in _
der xlsm-Datei gefunden werden konnte
Else
strFehler = strFehler & sListZeichen & "Die Spalte '" & _
ArrayQuelle(nIndex) & "' wurde nicht in der Quell-Datei gefunden." & vbCr
MsgBox strFehler
Exit Sub
End If
End With
Ich glaube hier muss die Prüfung hin - bevor die XML-Datei geöffnet wird und die Übertragung der Daten beginnt oder eben ganz am Anfang? Und erst wenn die Msg-Box ein "ok" ausgibt soll die XML-Datei generiert werden.

If IsArray(ArrayXLSM) Then
With oXML.Sheets("neue Zustandsbeschreibungen") 'Name des Tabellenblattes, welches in der  _
_
_
xml-Datei benutzt wird
nIndexXML = Application.Match(ArrayZiel(nIndex), .Rows(27), 0) 'sucht in der Zeile 27 _
nach den Spaltenbeschriftungen
If IsNumeric(nIndexXML) Then
'alle Inhalte der Zellen ab Zeile 28 werden für neue Daten gelöscht
.Range(.Cells(28, nIndexXML), .Cells(.Rows.Count, nIndexXML)).ClearContents
Set rngXML = .Cells(28, nIndexXML) 'erste Einfügezelle
rngXML.Resize(UBound(ArrayXLSM), 1) = ArrayXLSM 'Daten aus Array einfügen
Else
strFehler = strFehler & sListZeichen & "Die Spalte '" & _
ArrayZiel(nIndex) & "' wurde nicht in der Ziel-Datei gefunden." & vbCr
MsgBox strFehler
Exit Sub
an dieser Stelle gekürzt
Eine Beispieldatei hilft hier wohl auch nicht weiter, oder?
Telefonisch wäre so etwas viel einfacher zu erklären.
Lieben Gruß
Sandra

Anzeige
AW: VBA-Prüfung nach vergessenen Zellen
08.01.2015 13:04:57
Rudi
Hallo,
setz die Prüfung vor
'hier wird festgelegt welche Datei geöffnet werden soll und wo diese gespeichert ist

Wenn ein Fehler auftritt, wird der Code ja mit Exit Sub abgebrochen.
Gruß
Rudi

VBA-Prüfung nach vergessenen Zellen
08.01.2015 17:05:16
Sandra
Hi Rudi,
doch so einfach?!?!?!
Funktioniert!!!! :)
DANKE.
P. s. Kann ich beim Speichern der xml-Datei und der xlsx-Datei die Endlosschleife umgehen, die entsteht wenn ich die Datei generiert habe, diese geöffnet sind und dann das Makro erneut ausführe. Ich werde gefragt ob ich die Datei überschreiben will. Wenn ich das verneine geht das speichern unter Feld auf - aber ohne Vorgabe des Dateityps und nicht im richtigen Pfad. Wenn das jetzt jemand macht der nicht weiß wie er den Dateityp auswählen muss und deshalb auf abbrechen klickt, der kann das dann immer und immer wieder machen.
Gut wäre ein fester Pfad und eine feste Dateitypvorgabe.
Leider weiß ich nicht wie ich das machen muss und wo das genau hingehört.
Bekommst Du das auch noch gelöst?
Lieben Dank & Gruß
Sandra

Anzeige
funktioniert doch nicht :(
09.01.2015 14:27:41
Sandra
Hallo Rudi,
doch nicht so einfach.
Wenn ich keinen Fehler habe ist es okay und funktioniert. Ist eine Zelle nicht ausgefüllt läuft die Prüfung fehlerfrei durch (also keine leeren Zellen gefunden - was schon unverständlich ist). Die XML-Datei erstellt sich, wird gespeichert und danach öffnet sich das Speichern unter Fenster genau mit dem zuvor genannten Problem.
Was ist da jetzt falsch? Warum registriert die Prüfung jetzt keinen Fehler mehr?
Kannst du mir noch einmal helfen?
Lieben Gruß
Sandra

AW: funktioniert doch nicht :(
11.01.2015 16:48:14
Sandra
Hallo noch einmal in die Runde.
Ich habe jetzt noch einmal exzessiv getestet und auch das Makro etwas verändert. Eigentlich dürfte das Speichern beim falschen Pfad gar nicht funktionieren. Dennoch glaube ich das es an der Groß- und Kleinschreibung im Pfad lag das es nicht funktionierte. Ich habe den Pfad noch einmal angepasst und habe - was das Speichern angeht - keine Probleme mehr.
Aber die Prüfung funktioniert dennoch nicht. Egal welche Zelle ich nicht ausfülle - die Prüfung ergibt keinen Fehler.
Hier noch einmal den Code von beginn bis zur Prüfung:
Option Explicit
Sub Maengelliste_SKH()
Dim oXlSM As Workbook, oXML As Workbook
Dim nIndexXLSM, nIndexXML, MaxRow As Long, nIndex As Long
Dim rngXLSM As Range, rngXML As Range, ArrayXLSM
Dim strFehler As String
Dim ArrayQuelle, ArrayZiel
Const sListZeichen$ = "• "
'hier stehen die Überschriften, nach denen gesucht wird
'Wichtig! Die Reihenfolge muss bei beiden identisch sein
ArrayQuelle = Array("Betrifft", "verortete Zustandsbeschreibung", "Mangelart", "Vertragsart", " _
Gewerkegruppe", "Gewerk", "Bauteil", "Geschoss", _
"Nutzung", "Level D", "Raum", "Achse", "Foto", "Frist", "Nachfrist", "letzte Nachfrist", " _
Auftragnehmer", "betriebsrelevant", "Vorbereitung der Abnahme", _
"VL AG", "sicherheitsrelevant", "Restleistung", "Bauherr", "optisch", "Anspruch unsicher", " _
Nachweis fehlt")
ArrayZiel = Array("betrifft", "Zustandsbeschreibung", "Mangelart", "Vertragsart", " _
Gewerkegruppe", "Gewerk", "Bauteil", "Geschoss", "Nutzung", _
"Level D", "Raum", "Achse", "Foto", "Frist", "Nachfrist", "letzte Nachfrist", "Auftragnehmer", " _
betriebsrelevant", "Vorbereitung der Abnahme", _
"VL AG", "sicherheitsrelevant", "Restleistung", "Bauherr", "optisch", "Anspruch unsicher", " _
Nachweis fehlt")
'hier erfolgt die Prüfung nach ggf. vergessenen Zellen
Dim zeile As Long, spalte As Long
Dim i As Integer
Dim strausgabe As String, strzelle As String, x As String
Dim wks As Worksheet
Dim check As Boolean
Set wks = Sheets(1)
Dim spalten()
Dim spaltennamen()
Dim spaltenausgabe()
x = ""
spalten() = Array(1, 2, 9, 10, 11, 12, 13, 15, 17, 20)
spaltennamen() = Array("In der Spalte Bauteil (A)", "In der Spalte Geschoss (B)", "In der  _
Spalte Betrifft (I)", "In der Spalte Zustandsbeschreibung (J)", _
"In der Spalte Mangelart (K)", "In der Spalte Vertragsart (L)", "In der Spalte Gewerkegruppe (M) _
", "In der Spalte Gewerk (O)", _
"In der Spalte Frist (Q)", "In der Spalte Auftragnehmer (T)")
spaltenausgabe() = Array(x, x, x, x, x, x, x, x, x, x)
For i = 0 To UBound(spalten())
spaltenausgabe(i) = spaltennamen(i) & " in den Zeilen: "
Next i
With wks
For zeile = 3 To 500
If .Cells(zeile, 1).Value  "" Then
For i = 0 To UBound(spalten())
On Error GoTo schleife
If Cells(zeile, spalten(i)).Value = 0 Then
schleife:
spaltenausgabe(i) = spaltenausgabe(i) & vbCrLf & zeile & ",  " & vbCrLf
check = True
End If
Next i
End If
Next zeile
End With
If check = True Then
For i = 0 To UBound(spalten())
strausgabe = strausgabe & spaltenausgabe(i) & vbCrLf
Next i
MsgBox "Fehlerhaft ausgefüllte Zellen: " & vbCrLf & vbCrLf & _
strausgabe
Exit Sub
Else
MsgBox "Es konnten keine leeren Zellen in den Spalten Bauteil (A), Geschoss (B), Betrifft ( _
I), Zustandsbeschreibung (J), Mangelart (K), Vertragsart (L), Gewerkegruppe (M), Gewerk (O), Frist (Q) und Auftragnehmer (T) gefunden werden!"
End If

Was mache ich denn falsch? Es funktionierte bevor ich die Prüfung vorgezogen habe.
Danke & Gruß
Sandra

Anzeige
hier muss das Problem liegen
11.01.2015 17:48:47
Sandra
Hallo noch einmal,
ich probiere und probiere und probiere und stelle fest.... dieser Teil muss etwas mit der nicht funktionierenden Prüfung zu tun haben:
For zeile = 3 To 500
If .Cells(zeile, 1).Value  "" Then
Die erste Zeile gibt doch an, in welchen Zeilen die Prüfung stattfinden soll?! Wofür steht die zweite Zeile? Wenn ich sie verstehen würde könnte ich sie vielleicht auch anpassen.
Könnt Ihr helfen?
Danke!!!
Gruß
Sandra

AW: hier muss das Problem liegen
11.01.2015 19:40:10
Gerold
Hallo Sandra
Diese Meldung ist nicht richtig

Exit Sub
Else
MsgBox "Es konnten keine leeren  Zellen in den Spalten Bauteil (A), ...
sondern müsste so lauten

Exit Sub
Else
MsgBox "Es konnten keine ausgefülten Zellen in den Spalten Bauteil (A), ....

________________
Gruß Gerold

Anzeige
AW: hier muss das Problem liegen
11.01.2015 21:57:48
Sandra
Hallo Gerold,
das verstehe ich jetzt nicht?! Die MsgBox gibt doch nur einen vorher definierten Text aus?! Dieser Text hat doch keinen Einfluss auf die eigentliche Prüfung. Oder habe ich da jetzt einen Denkfehler?
Gruß
Sandra

AW: hier muss das Problem liegen
12.01.2015 16:22:33
Gerold
Hallo Sandra

' Hier wird überprüft ob in Spalte A / Zeilen 3 - 500
' die Zelle (Cells(zeile, 1)) nicht leer ist
With wks
For zeile = 3 To 500
If .Cells(zeile, 1).Value  "" Then

If check = True Then
'check kann schon true sein - wenn mindestens eine Zelle (Zeilen 3-500 Spalte 1)
'einen Wert enthält
'und eine der anderen Spalten den Wert 0 enthält durch diese Abfrage
'If Cells(zeile, spalten(i)).Value = 0 Then
'schleife:
'                    spaltenausgabe(i) = spaltenausgabe(i) & vbCrLf & zeile & ",  " & vbCrLf
'                    check = True
For i = 0 To UBound(spalten())
strausgabe = strausgabe & spaltenausgabe(i) & vbCrLf
Next i
MsgBox "Fehlerhaft ausgefüllte Zellen: " & vbCrLf & vbCrLf & _
strausgabe
Exit Sub
Else
'check ist immer false  - wenn keine der Zellen (Zeilen 3-500 / Spalte 1) einen Wert enthält
'Also falscher Text in MsgBox weil danach keine überprüfung der anderen Spalten.
MsgBox "Es konnten keine leeren Zellen in den Spalten Bauteil (A), Geschoss (B)," _
& "Betrifft ( I), Zustandsbeschreibung (J), Mangelart (K), Vertragsart (L)," _
& " Gewerkegruppe (M), Gewerk (O), Frist (Q) und Auftragnehmer (T) gefunden werden!"
End If
________________
Gruß Gerold
Anzeige

18 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige