Datenexport diverser Spalten in andere Datei

[gregy]

Hallo,

ich kann etwas Hilfe bei VBA gebrauchen :19: 

Derzeit importiere ich -aus einer stets gleich formatierten aber jedes mal mit einer anderen Anzahl an Zeilen- Daten aus einer Ausschreibungsdatei in meine Kalkulation. Dies funktioniert auch bisher super und deshalb habe ich versucht den Code für den Import umzustricken für den Export (mit mäßigerm erfolg, da die Anforderung komplexer). Hier der Code, die Anforderung weiter unten. 

Code:

[color=#666666]Option Explicit
Dim Stamm_imp As String
Dim varFile_imp As Variant
Dim varName_imp As Variant
Dim Blatt_imp As String[/color]
[size=small][font=Menlo, Monaco, Consolas,]Public Sub gaeb_import()
   Application.ScreenUpdating = False
   Dim lstRow As Long
   
   On Error GoTo Err
       Stamm_imp = ActiveWorkbook.Name
       varFile_imp = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx", , "XLSx", " _
Auswahl", _
   False)
       If TypeName(varFile_imp) Like "Boolean" Then
           MsgBox "Keine Datei gewählt!", vbInformation
           Exit Sub
       Else
       
       varName_imp = Right$(varFile_imp, Len(varFile_imp) - InStrRev(varFile_imp, "\"))
       Workbooks.Open varFile_imp
       lstRow = Workbooks(varName_imp).Sheets("GAEB_Konverter_LV").Cells(Rows.Count, 4).End( _
xlUp).Row
   
   
       Workbooks(varName_imp).Sheets("GAEB_Konverter_LV").Range("B2:B" & lstRow - 1).Copy
       Workbooks(Stamm_imp).Sheets("Kalkulation").Range("C5").PasteSpecial xlPasteValues
       Workbooks(varName_imp).Sheets("GAEB_Konverter_LV").Range("C2:C" & lstRow - 1).Copy
       Workbooks(Stamm_imp).Sheets("Kalkulation").Range("D5").PasteSpecial xlPasteValues
       Workbooks(varName_imp).Sheets("GAEB_Konverter_LV").Range("D2:F" & lstRow - 1).Copy
       Workbooks(Stamm_imp).Sheets("Kalkulation").Range("E5").PasteSpecial xlPasteValues
       Workbooks(varName_imp).Sheets("GAEB_Konverter_LV").Range("G2:G" & lstRow - 1).Copy
       Workbooks(Stamm_imp).Sheets("Kalkulation").Range("AX5").PasteSpecial xlPasteValues
       Workbooks(varName_imp).Close
       Application.CutCopyMode = False
   
       End If
       Sheets("Kalkulation").Range("E5").Select
     Exit Sub
Err:
     Call MsgBox("Bitte überprüffen ob die Tabellen" _
                 & vbCrLf & "Nord und Süd vohanden sind 1" _
                 , vbExclamation, "Fehler")
     
End Sub[/font][/size]

Nachdem nun die Kalkulation mit Daten gefüllt wurde möchte ich die Preise wiederum exportieren in die Datei aus welcher die Grunddaten kamen. Beim Import habe ich mir die OZ (Ordnungszahlen) in die Kalkulation geholt. Bei Übereinstimmung dieser OZs sollen im Falle, dass in der jeweiligen Zeile in der Spalte C (GAEB-Ausschreibung) entweder "E - Bedarfspos. o. GB" oder "P - Pauschalposition" steht der Wert von AX aus der Kalkulation in die jeweilige Zeile in Spalte I (GAEB-Ausschreibung) übertragen werden ansonsten -wenn keines dieser Bedingungen passt- der Wert aus AW.

Mein erster Versuch dies zu lösen bestand darin, den Code für den Import der Daten einfach auch auf den Export anzupassen zzgl. einer Vergleichsfunktion Spalte für Spalte. Aber genau daran scheitert es. Ich schaffe es nicht eben die Zeilen der beiden Tabelle über die Ordnungszahl zu vergleichen und anschließend noch zu überprüfen ob es sich um eine "E - Bedarfspos. o. GB" oder "P - Pauschalposition" handelt um anschließend die Folgezeile zu überprüfen bis die letzte Zeile aus der GAEB-Ausschreibung (also die Datei in welche exportiert wird) erreicht ist.

Kann mir evtl. von Euch jemand weiter helfen? 

Hier die Tabellen
Kalkulation (in welchem zunächst aus der GAEB-Ausschreibung importiert wird und nun die Preise zu exportieren sind) 
GAEB-Ausschreibung:

Vielen Dank im Voraus!

Gruß Gregy

[schauan]

HI Gregy,

ich hab mir Deine Dateien nicht angeschaut, bin mir aber sicher, dass wir auch mit Theorie weiterkommen

Erstes Problem wäre, in der einen Datei die zur anderen Datei passende Zeile zu finden. Das könnte doch so funktionieren wie mit der Suchfunktion von Excel? Dan Code dazu kannst Du aufzeichnen. Das könnte so aussehen:

Sub Makro1()
'
' Makro1 Makro
'

'
Columns("A:A").Select
Selection.Find(What:="Berta", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
End Sub

gekürzt und mit Rückgabe der Zeilennummer:

Sub Makro1()
Dim lZeile&
lZeile = Columns("A:A").Find(What:="Berta", After:=Cells(1, 1), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Row
End Sub

Vor Columns dann natürlich noch Workbook und Sheet. Falls es die Ordnungszahl nicht gebe sollte, kommt so natürlich ein Fehler. Wenn das passieren kann, müsste man etwas anders vorgehen. Wäre das schon mal ein erster Ansatz? Dann machen wir weiter

[gregy]

Moin schauan,

vielen Dank für Deine Hilfe. Ich habe Dein Script mal an meine Grundbedürfnisse angepasst

Code:

Sub gaeb_export()
Application.ScreenUpdating = False
Dim lZeile As String
Dim Stamm_exp As String
Dim varFile_exp As Variant
Dim varName_exp As Variant
Dim Blatt_exp As String


   On Error GoTo Err
       Stamm_exp = ActiveWorkbook.Name
       varFile_exp = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx", , "XLSx", "Auswahl", _
       False)
       If TypeName(varFile_exp) Like "Boolean" Then
           MsgBox "Keine Datei gewählt!", vbInformation
           Exit Sub
       Else

       varName_exp = Right$(varFile_exp, Len(varFile_exp) - InStrRev(varFile_exp, "\"))
       Workbooks.Open varFile_exp

       lZeile = Workbooks(varName_exp).Sheets("GAEB_Konverter_LV").Columns("B:B").Find(What:="Berta", After:=Cells(2, 2), LookIn:=xlFormulas, _
       LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
       MatchCase:=False, SearchFormat:=False).Row

       Range("BI1").Value = lZeile


       End If

Err:
     Call MsgBox("FEHLER" _
                 & vbCrLf & "Bitte wenden Sie sich an den Administrator" _
                 , vbExclamation, "Fehler")

End Sub

Hiermit kann ich eine Datei auswählen, in welcher der Export stattfinden soll. Bisher schreibe ich in die neu zu öffnende Datei in BI1 die Zeilennummer rein was auch gut funzt.

Nun wollte ich schonmal weiter machen und habe folgendes angefangen

Code:

Sub gaeb_export()
Application.ScreenUpdating = False
Dim sucheZeile As String
Dim Stamm_exp As String
Dim varFile_exp As Variant
Dim varName_exp As Variant
Dim Blatt_exp As String
Dim oznum As String
Dim Rowcalc As String

'        On Error GoTo Err

           Stamm_exp = ActiveWorkbook.Name

           varFile_exp = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx", , "XLSx", "Auswahl", _
           False)
           
           If TypeName(varFile_exp) Like "Boolean" Then
               MsgBox "Keine Datei gewählt!", vbInformation
               Exit Sub
           Else
   
           varName_exp = Right$(varFile_exp, Len(varFile_exp) - InStrRev(varFile_exp, "\"))

           lstRow = Workbooks(Stamm_exp).Sheets("Kalkulation").Cells(Rows.Count, 4).End(xlUp).Row
           
           Rowcalc = 5


Check_Rowcalc:
               If Workbooks(Stamm_exp).Cells(Rowcalc, 3).Value = "" Then

                   Rowcalc = Rowcalc + 1
                   GoTo Check_Rowcalc

               Else: oznum = Workbooks(Stamm_exp).Cells(Rowcalc, 3)
               End If
               
           Workbooks.Open varFile_exp
           sucheZeile = Workbooks(varName_exp).Sheets("GAEB_Konverter_LV").Columns("B:B").Find(What:="Berta", After:=Cells(2, 2), LookIn:=xlFormulas, _
           LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
           MatchCase:=False, SearchFormat:=False).Row
   
           Range("BI1").Value = sucheZeile
   
   
           End If

   Exit Sub

Err:
     Call MsgBox("FEHLER" _
                 & vbCrLf & "Bitte wenden Sie sich an den Administrator" _
                 , vbExclamation, "Fehler")


End Sub

und hier verzweifel ich! Der Code läuft durch bis Zeile "Rowcalc:", bzw. eine Zeile dahinter. Es erscheint der Laufzeitfehler 438 (Objekt unterstützt diese Eigenschaft oder Methode nicht). Meine Absicht war es, die erste gefüllte Zeile in Spalte C zu finden und bei Zeile 5 anzufangen und immer weiter hoch zu zählen wenn die jeweilige Zeile leer ist um die erste beschriebene Zelle in der Variable oznum abzulegen.

An der Stelle komm ich nicht so recht weiter...

Freue mich schon auf Deine Idee  :17: