AW: 1. Frage = erledigt ... nun kompliziert weiter ...
05.05.2011 13:33:10
Sandra
Hallo Tino,
ich bin es noch einmal.
Das mit dem "nur Werte kopieren" klappt ja ganz prima. Und entsprechend Deines Vorschlages kann ich
den Rest auch ergänzen. Aber in Bezug auf die Datei, die als Quelle dient brauche ich Deine Hilfe. Da bin
ich mir nicht so sicher, wie ich den Text umschreiben muss.
Und dann habe ich noch eine Frage. Ich muss den Text aus mehreren Spalten transferieren. Das ist soweit
ja kein Problem. Ich habe das jetzt schon einmal wie folgt weitergeführt:
Sub Test_HDI1()
' xlm-Datei Vorlage Zustandsbeschreibung öffnen
Workbooks.Open Filename:= _
"\\192.168.10.4\GKK-Projekte\Projekte\2009\09-02 HDI\0000 Intern\0000 MUSTER\HDI _
VORLAGE Zustandsbeschreibung.xml"
' Betrifft in xlm-Datei kopieren.
Dim oXlSM As Workbook, oXLM As Workbook
Dim nIndexXLSM, nIndexXLM, MaxRow As Long
Dim rngXLSM As Range, rngXLM As Range, ArrayXLSM
Set oXlSM = Workbooks("110504 HDI Mustervorlage Maengelliste.xlsm") 'Deine xls
Set oXLM = Workbooks("HDI VORLAGE Zustandsbeschreibung.xml")
With oXlSM.Sheets("Mängel vor der Abnahme") 'Tabellenname in der Spalte Betrifft vorhanden ist
nIndexXLSM = Application.Match("Betrifft", .Rows(7), 0) 'suche Spalte Betrifft in Zeile 7
If IsNumeric(nIndexXLSM) Then
MaxRow = .Cells(.Rows.Count, nIndexXLSM).End(xlUp).Row 'letzte Zeile in Spalte
If MaxRow
Sub 'keine Daten ab Zeile 8
Set rngXLSM = .Range(.Cells(8, nIndexXLSM), .Cells(MaxRow, nIndexXLSM))
If MaxRow > 8 Then
ArrayXLSM = rngXLSM
Else
ArrayXLSM = rngXLSM.Resize(, 2)
ReDim Preserve ArrayXLSM(1 To UBound(ArrayXLSM), 1 To 1)
End If
Else
MsgBox "Betrifft nicht in XLSM gefunden"
Exit Sub
End If
End With
With oXLM.Sheets("neue Zustandsbeschreibungen") 'Tabellenname der xlm-Datei
nIndexXLM = Application.Match("betrifft", .Rows(18), 0) 'suche Spalte betrifft in Zeile 18
If IsNumeric(nIndexXLM) Then
'leer machen für neue Daten
.Range(.Cells(19, nIndexXLM), .Cells(.Rows.Count, nIndexXLM)).ClearContents
Set rngXLM = .Cells(19, nIndexXLM) 'erste Einfügezelle
rngXLM.Resize(UBound(ArrayXLSM), 1) = ArrayXLSM 'Daten aus Array einfügen
Else
MsgBox "betrifft nicht in XLM gefunden"
End If
End With
' verortete Zustandsbeschreibung in xlm-Datei kopieren.
With oXlSM.Sheets("Mängel vor der Abnahme") 'Tabellenname in der Spalte Betrifft vorhanden ist
nIndexXLSM = Application.Match("verortete Zustandsbeschreibung", .Rows(7), 0) 'suche Spalte _
verortete Zustandsbeschreibung in Zeile 7
If IsNumeric(nIndexXLSM) Then
MaxRow = .Cells(.Rows.Count, nIndexXLSM).End(xlUp).Row 'letzte Zeile in Spalte
If MaxRow
Sub 'keine Daten ab Zeile 8
Set rngXLSM = .Range(.Cells(8, nIndexXLSM), .Cells(MaxRow, nIndexXLSM))
If MaxRow > 8 Then
ArrayXLSM = rngXLSM
Else
ArrayXLSM = rngXLSM.Resize(, 2)
ReDim Preserve ArrayXLSM(1 To UBound(ArrayXLSM), 1 To 1)
End If
Else
MsgBox "verortete Zustandsbeschreibung nicht in XLSM gefunden"
Exit Sub
End If
End With
With oXLM.Sheets("neue Zustandsbeschreibungen") 'Tabellenname der xlm-Datei
nIndexXLM = Application.Match("Zustandsbeschreibung", .Rows(18), 0) 'suche Spalte _
Zustandsbeschreibung in Zeile 18
If IsNumeric(nIndexXLM) Then
'leer machen für neue Daten
.Range(.Cells(19, nIndexXLM), .Cells(.Rows.Count, nIndexXLM)).ClearContents
Set rngXLM = .Cells(19, nIndexXLM) 'erste Einfügezelle
rngXLM.Resize(UBound(ArrayXLSM), 1) = ArrayXLSM 'Daten aus Array einfügen
Else
MsgBox "Zustandsbeschreibung nicht in XLM gefunden"
End If
End With
' Interne Nummer in xlm-Datei kopieren.
With oXlSM.Sheets("Mängel vor der Abnahme") 'Tabellenname in der Spalte Interne Nummer _
vorhanden ist
nIndexXLSM = Application.Match("Interne Nummer", .Rows(7), 0) 'suche Spalte Interne Nummer _
in Zeile 7
If IsNumeric(nIndexXLSM) Then
MaxRow = .Cells(.Rows.Count, nIndexXLSM).End(xlUp).Row 'letzte Zeile in Spalte
If MaxRow
Sub 'keine Daten ab Zeile 8
Set rngXLSM = .Range(.Cells(8, nIndexXLSM), .Cells(MaxRow, nIndexXLSM))
If MaxRow > 8 Then
ArrayXLSM = rngXLSM
Else
ArrayXLSM = rngXLSM.Resize(, 2)
ReDim Preserve ArrayXLSM(1 To UBound(ArrayXLSM), 1 To 1)
End If
Else
MsgBox "Interne Nummer nicht in XLSM gefunden"
Exit Sub
End If
End With
With oXLM.Sheets("neue Zustandsbeschreibungen") 'Tabellenname der xlm-Datei
nIndexXLM = Application.Match("Nr", .Rows(18), 0) 'suche Spalte Nr in Zeile 18
If IsNumeric(nIndexXLM) Then
'leer machen für neue Daten
.Range(.Cells(19, nIndexXLM), .Cells(.Rows.Count, nIndexXLM)).ClearContents
Set rngXLM = .Cells(19, nIndexXLM) 'erste Einfügezelle
rngXLM.Resize(UBound(ArrayXLSM), 1) = ArrayXLSM 'Daten aus Array einfügen
Else
MsgBox "Nr nicht in XLM gefunden"
End If
End With
End Sub
Nun habe ich aber insgesamt mehr als 20 Spalten zu übertragen. Wenn nach der Spaltenüberschrift
gesucht werden muss, dann kann ich es aber wahrscheinlich nicht umgehen einen so ausführlich Code zu
verfassen, oder?
Und dann noch eine Frage. Es müssen noch ein paar Spezialitäten eingebaut werden. Die haben aber
noch etwas Zeit!!! Ich will sie nur schon einmal angesprochen haben.
1. Es müssen einige Spalten (in der xlm-Datei) darauf hin überprüft werden, dass Sie ausgefüllt sind. Also
wenn z. B. die Zellen A19 bis A153 ausgefüllt sind, dann müssen die Zellen B19 bis B153 und H19 bis H153
auch ausgefüllt sein.
2. Es muss dann aber wiederrum noch eine Prüfung erfolgen, dass der Inhalt, der z. B. in der Spalte D der
xlm-Datei transferiert wurde der Drop-Down-Liste entspricht. Die Daten die dort stehen dürfen sind immer
in der gleichen Spalte erfasst. In den Zeilen 3 bis 16. Also was in D18 bis Dxxxx stehen darf steht in
D3:D16.
3. Nach dem transferieren der Daten muss das Abspeichern der xlm-Datei unter NEUEM Namen erzwungen
werden. Ggf. auch automatisch an einem bestimmten (vorgegebenem Ort) auf dem Server mit Dateiname
"aktuelles Datum + Dateiname der geöffneten xlm-Datei".
So. Soviel wollte ich gar nicht schreiben.
Würde mich freuen ganz bald wieder von Dir zu lesen.
Liebe Grüße aus dem sonnigen Hamburg
Sandra