Clever-Excel-Forum

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

HI Gregy,

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

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:

Zitat: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 Smile

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:

gregy

schauan

gregy