Beiträge zum Thread: automatische Datenupdate erstellen

Hallo Edmund,

das kann man via VBA so erschlagen:

Sub WerteLaden()

    Dim Pfad$, vImp$, arrA(), arrB(), arrC(), arrD(), arrE, arrF()

    Pfad = Application.GetOpenFilename("Excel Files (*.xlsx), *.xls", , "XLSx", "Auswahl", _

        False)

    If TypeName(Pfad) Like "Boolean" Then

        MsgBox "Keine Datei gewählt!", vbInformation

        Exit Sub

    Else

        Workbooks.Open Pfad

        vImp = Right$(Pfad, Len(Pfad) - InStrRev(Pfad, "\"))

        With Workbooks(vImp).Sheets("Tabelle1")

            arrA = .Range("B5:C9").Value

            arrB = .Range("B15:C15").Value

            arrC = .Range("D18:F19").Value

            arrD = .Range("G24:I26").Value

            .Range("G31:G33,G36:G38").NumberFormat = "General"

            arrE = .Range("G31:H33").Value

            arrF = .Range("G36:H38").Value

            Application.DisplayAlerts = False

            Workbooks(vImp).Close

            Application.DisplayAlerts = True

        End With

    End If

    With Tabelle3

        .Unprotect Password:="Test"

        .Cells(3, 2).Resize(5, 2) = arrA

        .Protect Password:="Test"

    End With

    With Tabelle1

        .Unprotect Password:="Test"

        .Cells(4, 2).Resize(1, 2) = arrB

        .Cells(7, 4).Resize(2, 3) = arrC

        .Cells(13, 7).Resize(3, 3) = arrD

        .Cells(20, 7).Resize(3, 2) = arrE

        .Cells(25, 7).Resize(3, 2) = arrF

        .Protect Password:="Test"

    End With

End Sub

Gruß Uwe

Hallo Uwe,

SUPER !!!
vielen lieben Dank, klappt hervorragend, werde es nun in meine Original Tabelle übertragen.
Nur noch eine kleine Bitte:

Die Updateversion ( HV-PrämienTool B1 ) würde ich noch gerne in das Programm schreiben lassen ( HV-Tool A3 ) da beim Start die Updateversion abgefragt wird und bei Ungleichheit das Update gestartet wird.

Kannst du mir die Zeile noch schicken und zeigen wo ich diese einbauen soll?

Danke noch mal für deine tolle Hilfe.

Edmund

Hallo Edmund,

normalerweise so:

Sub WerteLaden()

    Dim Pfad$, vImp$, arrA(), arrB(), arrC(), arrD(), arrE, arrF(), dateUp As Date

    Pfad = Application.GetOpenFilename("Excel Files (*.xlsx), *.xls", , "XLSx", "Auswahl", _

        False)

    If TypeName(Pfad) Like "Boolean" Then

        MsgBox "Keine Datei gewählt!", vbInformation

        Exit Sub

    Else

        Workbooks.Open Pfad

        vImp = Right$(Pfad, Len(Pfad) - InStrRev(Pfad, "\"))

        With Workbooks(vImp).Sheets("Tabelle1")

            dateUp = .Range("B1")

            arrA = .Range("B5:C9").Value

            arrB = .Range("B15:C15").Value

            arrC = .Range("D18:F19").Value

            arrD = .Range("G24:I26").Value

            .Range("G31:G33,G36:G38").NumberFormat = "General"

            arrE = .Range("G31:H33").Value

            arrF = .Range("G36:H38").Value

            Application.DisplayAlerts = False

            Workbooks(vImp).Close

            Application.DisplayAlerts = True

        End With

    End If

    With Tabelle3

        .Unprotect Password:="Test"

        .Cells(1, 2) = dateUp

        .Cells(3, 2).Resize(5, 2) = arrA

        .Protect Password:="Test"

    End With

    With Tabelle1

        .Unprotect Password:="Test"

        .Cells(4, 2).Resize(1, 2) = arrB

        .Cells(7, 4).Resize(2, 3) = arrC

        .Cells(13, 7).Resize(3, 3) = arrD

        .Cells(20, 7).Resize(3, 2) = arrE

        .Cells(25, 7).Resize(3, 2) = arrF

        .Protect Password:="Test"

    End With

End Sub

Das setzt voraus, dass im Workbook "Prämien-HV-Tool.xlsx" in Blatt "Tabelle1" Zelle B2 ein echtes Datum steht.
Da aber in B1 ein Text statt Datum + Zellformat steht muss die Dimensionierung der Variable dateUp statt dateUp as Date so geändert werden: dateUp$

Gruß Uwe

Hallo Uwe,

vielen Dank.
Nachdem ich die Felder in Datumfelder umformatiert habe klappt alles super.

Nun habe ich den VBA Code in meine Originaldatei eingebaut und die einzelnen Felder aktualisiert.
Leider klappt nun gar nichts mehr.
Was habe ich falsch gemacht?

Ich habe einmal die Originaldatei hochgeladen: https://www.herber.de/bbs/user/180592.xlsm

Kann es daran liegen, dass ich mehr als 3 Blätter in der Datei habe?

Sorry, für die Umstände, aber ich habe nun schon einiges ausprobiert leider alles ohne Erfolg.

LG
Edmund

sorry; Passwort für VBA ist provistar

Noch was: dein Code steht in Modul 4

Hallo Edmund,

das Schreiben erfolgt über den Modulnamen des Tabellenblattes. Da kann ich nur mutmaßen, dass in Zellen der Tabelle5 und dann in Zellen der Tabelle3 geschrieben werden soll.
Modulnamen sind nicht zu verwechseln mit Tabellenblattnamen.

Des Weiteren, um unnötiges Durchlaufen von Events in den Modulen zu verhindern, habe ich dies mit Application.EnebleEvents = False ausgeschaltet und mit Application.EnebleEvents = True am Ende wieder eingeschaltet.

Da die komplementären Daten (Prämien-HV-Tool.xlsx) zwecks Tests fehlen kann ich so leider nicht viel weiterhelfen. Vergleiche mit deiner Beispieldatei in Ruhe die Zellbereiche jedes einzelnen Arrays und schau dir den Inhalt im Lokalfenster des VBA-Editors genau an, ob der Inhalt korrekt ist. Es gibt zum Beispiel eine Besonderheit, Text Eurowerte mit zu vielen Nachkommastellen, welche passend aufbereitet werden müssen um Fehler im Doubleformat in den Arrayzellen zu verhindern.

Gruß Uwe

hier noch der Code:

Sub Update()

    Dim Pfad, vImp$, arrA(), arrB(), arrC(), arrD(), arrE, arrF(), dateUp As Date

    Pfad = Application.GetOpenFilename("Excel Files (*.xlsx), *.xls", , "XLSx", "Auswahl", _

        False)

    If TypeName(Pfad) Like "Boolean" Then

        MsgBox "Keine Datei gewählt!", vbInformation

        Exit Sub

    Else

        Application.EnableEvents = False

        Workbooks.Open Pfad

        vImp = Right$(Pfad, Len(Pfad) - InStrRev(Pfad, "\"))

        With Workbooks(vImp).Sheets("Tabelle1")

            dateUp = .Range("B1")                    'Updatestand

            arrA = .Range("B66:C72").Value           'Baukostenindes usw.

            arrB = .Range("D5:E5").Value             'Beitragssätze

            arrC = .Range("D19:F20").Value           'Glas

            arrD = .Range("F33:H35").Value           'HuG

            .Range("F51:F53,F56:F58").NumberFormat = "General"

            arrE = .Range("F51:H53").Value           'GSH oberirdisch

            arrF = .Range("F56:H58").Value           'GSH unterirdisch

            Application.DisplayAlerts = False

            Application.EnableEvents = True

            Workbooks(vImp).Close

            Application.DisplayAlerts = True

        End With

    End If

    With Tabelle5

        .Unprotect Password:="Test"

        .Cells(1, 2) = dateUp

        .Cells(3, 2).Resize(5, 2) = arrA

        .Protect Password:="Test"

    End With

    With Tabelle1

        .Unprotect Password:="Test"

        .Cells(4, 2).Resize(1, 2) = arrB

        .Cells(7, 4).Resize(2, 3) = arrC

        .Cells(13, 7).Resize(3, 3) = arrD

        .Cells(20, 7).Resize(3, 2) = arrE

        .Cells(25, 7).Resize(3, 2) = arrF

        .Protect Password:="Test"

    End With

End Sub

eine weitere zwingende Änderung ist die Variable Pfad. Diese ist natürlich Variant und nicht String, da sonst bei Abbruch Boolean nicht ausgewertet werden kann.

Gruß Uwe

Hallo Uwe,

leider funktioniert es nicht, schade

Habe den Code wie folgt mal aktualisiert:

Es soll nun alles in eine Tabelle übertragen werden Tabelle3 (Berechnung)
Das Einzige was funktioniert ist die Übertragung des Updatestands (dateUp)
Ich habe alle einzelnen Wert und die dazugehörigen Felder kontrolliert, stimmen alle.
Für mich etwas unklar, warum geht eine Übertragung und die restlichen Übertragungen nicht?
Ich bin ja nicht gerade die Leute in VBA darum wundert es mich, dass du nirgendwo schreibst welches Feld wohin kopiert werden soll.
Sorry, wenn es nicht geht dann muss ich es eben mit Makros machen, kopieren und einfügen.

mfg

Edmund

Sub Update()
Dim Pfad, vImp$, arrA(), arrB(), arrC(), arrD(), arrE, arrF(), dateUp As Date
Pfad = Application.GetOpenFilename("Excel Files (*.xlsx), *.xls", , "XLSx", "Auswahl", _
False)
If TypeName(Pfad) Like "Boolean" Then
MsgBox "Keine Datei gewählt!", vbInformation
Exit Sub
Else
Application.EnableEvents = False
Workbooks.Open Pfad
vImp = Right$(Pfad, Len(Pfad) - InStrRev(Pfad, "\"))
With Workbooks(vImp).Sheets("Tabelle1")

'wird in Sheet Tabelle3 (Berechnung) geschrieben
dateUp = .Range("B1") 'Updatestand (Prämien-HV-Tool B1 nach HV-Tool-Original Sheet Tabelle3 B1)
arrA = .Range("B68:C72").Value 'Baukostenindes usw. (Prämien-HV-Tool B5:C9 nach HV-Tool-Original B68:C72)
arrB = .Range("B5:C5").Value 'Beitragssätze (Prämien-HV-Tool B15:C15 nach HV-Tool-Original B5:C5)
arrC = .Range("D19:F20").Value 'Glas (Prämien-HV-Tool D18:F19 nach HV-Tool-Original D19:F20)
arrD = .Range("F33:H35").Value 'HuG (Prämien-HV-Tool G24:I26 nach HV-Tool-Original F33:H35)
.Range("F51:F53,F56:F58").NumberFormat = "General"
arrE = .Range("F51:H53").Value 'GSH oberirdisch (Prämien-HV-Tool G31:H33 nach HV-Tool-Original F51:H53)
arrF = .Range("F56:H58").Value 'GSH unterirdisch (Prämien-HV-Tool G36:H38 nach HV-Tool-Original F56:H58)

Application.DisplayAlerts = False
Application.EnableEvents = True
Workbooks(vImp).Close
Application.DisplayAlerts = True
End With
End If
With Tabelle3
.Unprotect Password:="Test"
.Cells(1, 2) = dateUp
.Cells(3, 2).Resize(5, 2) = arrA
.Protect Password:="Test"
End With
'With Tabelle1
.Unprotect Password:="Test"
.Cells(4, 2).Resize(1, 2) = arrB
.Cells(7, 4).Resize(2, 3) = arrC
.Cells(13, 7).Resize(3, 3) = arrD
.Cells(20, 7).Resize(3, 2) = arrE
.Cells(25, 7).Resize(3, 2) = arrF
.Protect Password:="Test"
End With
End Sub

Hallo Edmund,

das was du von mir bekommen hast, ist auf Basis deiner beiden Beispieldateien geschrieben.
Was in dieser Prozedur nicht passiert ist, das Daten von Zelle zu Zelle kopiert werden, sondern einer der effizienten Wege, um Daten in möglichst großen Blöcken zu lesen und zu schreiben.

Das was ich zuletzt von dir gesehen habe hat eigentlich nichts mit den Beispieldateien zu tun.
Gehe doch mal wie folgt vor:
Setze links vor der Zeile: "End If" einen Haltepunkt --> Klicke in die Prozedur -->Starte mi F5 -->Schau einfach mal im Lokalfenster des VBA Editors in die Arrays, ob alle benötigten Werte in den Array überhaupt enthalten sind.

Wenn, wenn nein sind die falschen Zellbereiche zum Einlesen in den Array(s) zugewiesen.
Da sehe ich, dass arrA nun statt 6 inzwischen mit 12 Zellen geladen wird. Das Tabellenblatt "Vorbelegung" hat den Modulnamen Tabelle5. Mit diesem Modulnamen wird in der Rückgabe gearbeitet.

.Cells(3, 2).Resize(5, 2) = arrA bedeutet: In Zeile 3 Spalte 2 (Spalte B also Zelle B3) liegt der Ankerpunkt zum Einfügen der Werte aus arrA. Der Bereich ab Ankerpunkt wird mittels Resize definiert. Also ab Zelle B3 wird von B3:C8 mit Werten gefüllt. Jetzt sollte dir klar sein, dass da eigentlich nichts wirklich passt.

Repariere so erst mal das Lesen und Schreiben des Arrays arrA.
Dann korrigiere mit Inhaltskontrolle im Lokalfenster alle restlichen Arrays auf passende Inhalte.
Dann schauen wir weiter.


Gruß Uwe

Hallo Uwe,

vielen Dank für deine Ausführungen, aber leider muss ich gestehen; ich habe keine Ahnung wovon du hier sprichst. Ich habe ja geschrieben, dass ich nicht viel von VBA verstehe und leider sagen mir die von dir aufgeführten Begriffe leider nichts.

Ich hatte dir die Tabelle mit den Prämien ( Prämien-HV-Tool ) und eine Musterdatei ( HV-Tool ) hochgeladen in der Annahme, dass man nachher mit Copy und Paste die einzelnen Felder aktualisieren könnte.
Nachdem ich dann deinen ersten Entwurf gesehen hatte, war nichts mit Kopieren und Austauschen der Felder, so habe ich dann die Original Datei ( HV-Tool-Original ) hochgeladen. Dort stehen die zu aktualisierenden Daten in der Blattregisterkarte „Berechnen“.
Dieses Programm wurde auch durch die Hilfe hier aus dem Forum erst möglich und ich hatte auf eine, mir verständliche Lösung gehoft.
Leider komme ich mit deiner Lösung so nicht weiter ( wahrscheinlich weil ich keine Ahnung habe ).
Ich bedanke mich aber trotzdem für deine Bemühungen und werde versuchen eine andere Lösung zu finden.

mfg
Edmund

Hallo Uwe,

habe mal das Update nach meinem Wissensstand erstellt, vielleicht nicht schön, aber es funktioniert.
Einziges Problem habe ich noch, dass das Tabellenblatt Berechnung nicht geschützt sein darf. Aber da ich es verstecke bzw. ausblende ist das das kleinste Übel.

Sub Update()
Pfad = Application.GetOpenFilename("Excel Files (*.xlsx), *.xls", , "XLSx", "Auswahl", _
False)
If TypeName(Pfad) Like "Boolean" Then
MsgBox "Keine Datei gewählt!", vbInformation
Exit Sub
Else
Application.EnableEvents = False
Workbooks.Open Pfad
vImp = Right$(Pfad, Len(Pfad) - InStrRev(Pfad, "\"))
With Workbooks(vImp).Sheets("Tabelle1")
'ActiveSheet.Unprotect Password:="Test"

Windows("HV-Tool-Orginal - Kopie.xlsm").Activate
Sheets("Eingabe").Select
Sheets("Berechnung").Visible = True

'Updatedatum
Windows("Prämien-HV-Tool.xlsx").Activate
Range("B1").Select
Selection.Copy
Windows("HV-Tool-Orginal - Kopie.xlsm").Activate
Sheets("Berechnung").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Baukostenindex usw.
Windows("Prämien-HV-Tool.xlsx").Activate
Range("B5:C9").Select
Application.CutCopyMode = False
Selection.Copy
Windows("HV-Tool-Orginal - Kopie.xlsm").Activate
Sheets("Berechnung").Select
Range("B68:C72").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Mindesbeitrag
Windows("Prämien-HV-Tool.xlsx").Activate
Range("B15:C15").Select
Application.CutCopyMode = False
Selection.Copy
Windows("HV-Tool-Orginal - Kopie.xlsm").Activate
Sheets("Berechnung").Select
Range("B5:C5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Glas
Windows("Prämien-HV-Tool.xlsx").Activate
Range("D18:F19").Select
Application.CutCopyMode = False
Selection.Copy
Windows("HV-Tool-Orginal - Kopie.xlsm").Activate
Sheets("Berechnung").Select
Range("D19:F20").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'HuG
Windows("Prämien-HV-Tool.xlsx").Activate
Range("G24:I26").Select
Application.CutCopyMode = False
Selection.Copy
Windows("HV-Tool-Orginal - Kopie.xlsm").Activate
Sheets("Berechnung").Select
Range("F33:H35").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'GSH-oberirdisch
Windows("Prämien-HV-Tool.xlsx").Activate
Range("G31:H33").Select
Application.CutCopyMode = False
Selection.Copy
Windows("HV-Tool-Orginal - Kopie.xlsm").Activate
Sheets("Berechnung").Select
Range("F51:H53").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'GSH-unterirdisch
Windows("Prämien-HV-Tool.xlsx").Activate
Range("G36:H38").Select
Application.CutCopyMode = False
Selection.Copy
Windows("HV-Tool-Orginal - Kopie.xlsm").Activate
Sheets("Berechnung").Select
Range("F56:H58").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Windows("Prämien-HV-Tool.xlsx").Close
Windows("HV-Tool-Orginal - Kopie.xlsm").Activate
Sheets("Eingabe").Select
Sheets("Berechnung").Visible = False

'Schaltfläche OK
MsgBox "Prämien erfolgreich aktualisiert", vbOKOnly, "HV - Tool"

End With
End If

End Sub

Hallo Edmund,

du wolltest zu Anfang eine VBA-Lösung, die hast du passend zu deinen Beispieldateien bekommen.
Mit Makrorecoder kann man sich zumindest bis zu einer gewissen Grade selbst helfen und umgeht somit den Weg sich mit der Materie auseinander zu setzen.
Schade eigentlich, aber das musst du mit dir selbst ausmachen.

Gruß Uwe