Bereich aus geschlossener Excel kopieren wenn Zellen befüllt sind

  • Excel

Es gibt 14 Antworten in diesem Thema. Der letzte Beitrag () ist von TeamBob.

    Bereich aus geschlossener Excel kopieren wenn Zellen befüllt sind

    Hallo
    Ich habe die folgende Funktion, mit der ich einen Bereich aus einer geschlossenen Excel auslesen lassen kann und diese Bereich dann in die
    derzeitge Excel Tabellen schreiben lassen kann. Da die Tabelle jeden Tag wächst und ich nicht den auszulesenden Bereich immer anpassenden möchte,
    würde ich gerne, dass immer nur der Bereich ausgelesen wird in der Quelldatei, der in der auch gefüllt ist. Also die Spalten sind immer gleich,
    aber die zeilen werden täglich mehr.
    Was gibt es daür für Lösungen?
    Vielen Dank

    Visual Basic-Quellcode

    1. Sub Bereich_auslesen()
    2. '** Dimensionierung der Variablen
    3. Dim pfad As String, datei As String, blatt As String, bereich As Range, zelle As Object
    4. '** Angaben zur auszulesenden Zelle
    5. pfad = "C:\Datenauswertung"
    6. datei = "Datei.xlsm"
    7. blatt = "Tabelle1"
    8. Set bereich = Range("A3:H10")
    9. '** Bereich auslesen
    10. For Each zelle In bereich
    11. '** Zellen umwandeln
    12. zelle = zelle.Address(False, False)
    13. '** Eintragen in Bereich
    14. ActiveSheet.Cells(zelle.Row, zelle.Column).Value = GetValue(pfad, datei, blatt, zelle)
    15. Next zelle
    16. End Sub
    17. Private Function GetValue(pfad, datei, blatt, zelle)
    18. '** Daten aus geschlossener Arbeitsmappe auslesen
    19. '*** Dimensionierung der Variablen
    20. Dim arg As String
    21. 'Sicherstellen, dass das datei vorhanden ist
    22. If Right(pfad, 1) <> "\" Then pfad = pfad & "\"
    23. If Dir(pfad & datei) = "" Then
    24. GetValue = "datei Not Found"
    25. Exit Function
    26. End If
    27. '** Das Argument erstellen
    28. arg = "'" & pfad & "[" & datei & "]" & blatt & "'!" & Range(zelle).Range("A1").Address(, , xlR1C1)
    29. '** Auslesen über Excel4Macro
    30. GetValue = ExecuteExcel4Macro(arg)
    31. End Function
    Fülle in deinem DestinationSheet eine Zelle mit folgender ArrayFormel:
    {=MAX(ZEILE(1:65535)*('D:\Projects\[MySourceFile.xlsb]Tabelle1'!A1:A65535<>""))}
    Musst halt entsprechend deiner Umgebung anpassen.
    Falls dein möglicher Range die 65535 Zeilen übersteigen kann, musst du das auch anpassen.
    Und falls die letzte Zelle nicht in Spalte A ist, auch das.

    Ich hoffe, du weißt, was eine Arrayformel ist und wie man sie einfügt.
    Wenn nicht, solltest du dich damit befassen.

    Aber ich bin heute gnädig:

    Visual Basic-Quellcode

    1. ​Sub CountForeignLines()
    2. Path = "D:\Projects\"
    3. Filename = "MySourceFile.xlsb"
    4. Sheetname = "Tabelle1"
    5. Range("B1").FormulaArray = "=MAX(ROW(1:65535)*('[" & Filename & "]" & Sheetname & "'!A1:A65535<>""""))"
    6. End Sub
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „petaod“ ()

    Hallo Danke erstmal für deine Hilfestellung.

    Der Code gibt ja die Zeile wieder in der der letzte Wert steht.
    Diese Wert müsste ich ja entsprechend in meinen oberen Quelltext einfügen, dass er nicht die Range("A3:H10") nimmt sondern von A3 bis zu der letzten Zelle.
    Wie genau kann ich das denn da implementieren?

    Velen Dank für die Hilfe
    VIelen Dank für deine Hilfe.
    Hat super geklappt und ich hätte noch eine weitere kleine Frage.
    Der oben gezeigte Code läd ja die Daten aus einer anderen Excel in die derzeit geöffnete.
    Nun habe ich den Fall das die Quelldatei 2 Tabellen hat, welche ich auch beide jeweils laden möchte.
    Also ich möchte Tabelle1 auch in Tabelle 1 und Tabelle 2 in Tabelle 2. Jetzt könnte ich es so handhaben,
    dass auf jeden Tabellenblatt ein neue Schaltfläche mit Quellcode hinterlege, aber es sollte eigentlich so sein,
    dass auf der ersten Seite nur eine Schaltfläche gedrückt wird und er dann die erste Tabelle läd und auch die 2 Tabelle.
    (Irgendwann wollte ich in diese Tabelle Daten aus weiteren Tabellen aus anderen Excel Datein laden lassen, also das die
    Admin Datei sich aus 5 Excel Datein die Daten laden kann. Ist das vom Punkte Geschwindigkeit usw. bedenklich)

    Visual Basic-Quellcode

    1. Sub Bereich_auslesen()
    2. '** Dimensionierung der Variablen
    3. Dim pfad As String, datei As String, blatt As String, bereich As Range, zelle As Object
    4. '** Angaben zur auszulesenden Zelle
    5. pfad = "C:\Users\"
    6. datei = "Datei1.xlsm"
    7. blatt = "Tabelle1"
    8. Range("J2").FormulaArray = "=MAX(ROW(1:65535)*('[" & datei & "]" & blatt & "'!A1:A65535<>""""))"
    9. Set bereich = Range("A3:H" & Range("J2").Value)
    10. '** Bereich auslesen
    11. For Each zelle In bereich
    12. '** Zellen umwandeln
    13. zelle = zelle.Address(False, False)
    14. '** Eintragen in Bereich
    15. ActiveSheet.Cells(zelle.Row, zelle.Column).Value = GetValue(pfad, datei, blatt, zelle)
    16. Next zelle
    17. End Sub
    18. Private Function GetValue(pfad, datei, blatt, zelle)
    19. '** Daten aus geschlossener Arbeitsmappe auslesen
    20. '*** Dimensionierung der Variablen
    21. Dim arg As String
    22. 'Sicherstellen, dass das datei vorhanden ist
    23. If Right(pfad, 1) <> "\" Then pfad = pfad & "\"
    24. If Dir(pfad & datei) = "" Then
    25. GetValue = "datei Not Found"
    26. Exit Function
    27. End If
    28. '** Das Argument erstellen
    29. arg = "'" & pfad & "[" & datei & "]" & blatt & "'!" & Range(zelle).Range("A1").Address(, , xlR1C1)
    30. '** Auslesen über Excel4Macro
    31. GetValue = ExecuteExcel4Macro(arg)
    32. End Function

    TeamBob schrieb:

    Ist das vom Punkte Geschwindigkeit usw. bedenklich
    Hängt natürlich von der Größe der Tabellen ab, aber eher nein.
    Notfalls musst du halt das ScreenUpdating und Calculating während des Updatevorgangs ausschalten.

    Ich hätte viel größere Bedenken, dass die angenommene Tabellenstruktur, aus der du einliest, keiner Änderung unterworfen sein darf, da du ja quasi im Blindflug nur Zelle auf Zelle kopierst.

    Ich wäre wahrscheinlich eher den Ansatz gegangen, die fremden Sheets per ODBC in das eigene Workbook zu verlinken und bei Bedarf zu refreshen.
    Aber das Design bleibt dir überlassen.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --
    Ok ich werde es mal so ausprobieren und dann schauen wie es funktioniert.

    Wie sieht es aus mit der Aktualisierung beide Tabellen von einen Button, da ich ja momentan auf jeden Sheet eine Schaltfläche habe zum Daten
    laden und dies sollte von einen Butten aus funktionieren.

    Vielen Dank
    Das einfachste ist vermutlich, wenn du in deinem ClickEvent einfach beide Methoden aufrufst.

    Visual Basic-Quellcode

    1. Tabelle1.Bereich_auslesen
    2. Tabelle2.Bereich_auslesen


    Allerdings solltest du das ActiveSheet. weglassen und die Definition von blatt wegwerfen und deren weiteres Vorkommen durch Name ersetzen..
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --
    Also ich habe versucht die beiden Datein in einen Event aufzurufen, aber irgendwie überschreibt überschreibt er mir immer die Tabelle1.
    er läd sie und überschreibt sie dann gleich wieder. Sieht auch relativ kompliziert auch mein Code (also viel zu umständlich wahrscheinlich)

    Visual Basic-Quellcode

    1. Sub Bereich_auslesen()
    2. '** Dimensionierung der Variablen
    3. Dim pfad1 As String, datei1 As String, blatt1 As String, blatt2 As String, bereich1 As Range, bereich2 As Range, zelle1 As Object, zelle2 As Object
    4. '** Angaben zur auszulesenden Zelle
    5. pfad1 = "C:\Users\"
    6. datei1 = "O_L.xlsm"
    7. blatt1 = "Oberflaeche"
    8. Range("J2").FormulaArray = "=MAX(ROW(1:65535)*('[" & datei1 & "]" & blatt1 & "'!A1:A65535<>""""))"
    9. Set bereich1 = Range("A3:H" & Range("J2").Value)
    10. blatt2 = "Laser"
    11. Range("J2").FormulaArray = "=MAX(ROW(1:65535)*('[" & datei1 & "]" & blatt2 & "'!A1:A65535<>""""))"
    12. Set bereich2 = Range("A3:H" & Range("J2").Value)
    13. '** Bereich1 auslesen
    14. For Each zelle1 In bereich1
    15. '** Zellen umwandeln
    16. zelle1 = zelle1.Address(False, False)
    17. '** Eintragen in Bereich
    18. Tabelle1.Cells(zelle1.Row, zelle1.Column).Value = GetValue1(pfad1, datei1, blatt1, zelle1)
    19. Next zelle1
    20. '** Bereich2 auslesen
    21. For Each zelle2 In bereich2
    22. '** Zellen umwandeln
    23. zelle2 = zelle2.Address(False, False)
    24. '** Eintragen in Bereich
    25. Tabelle2.Cells(zelle2.Row, zelle2.Column).Value = GetValue2(pfad1, datei1, blatt2, zelle2)
    26. Next zelle2
    27. End Sub
    28. Private Function GetValue1(pfad1, datei1, blatt1, zelle1)
    29. '** Daten aus geschlossener Arbeitsmappe auslesen
    30. '*** Dimensionierung der Variablen
    31. Dim arg As String
    32. 'Sicherstellen, dass das datei vorhanden ist
    33. If Right(pfad1, 1) <> "\" Then pfad1 = pfad1 & "\"
    34. If Dir(pfad1 & datei1) = "" Then
    35. GetValue = "datei Not Found"
    36. Exit Function
    37. End If
    38. '** Das Argument erstellen
    39. arg1 = "'" & pfad1 & "[" & datei1 & "]" & blatt1 & "'!" & Range(zelle1).Range("A1").Address(, , xlR1C1)
    40. '** Auslesen über Excel4Macro
    41. GetValue1 = ExecuteExcel4Macro(arg1)
    42. End Function
    43. Private Function GetValue2(pfad1, datei1, blatt2, zelle2)
    44. '** Daten aus geschlossener Arbeitsmappe auslesen
    45. '*** Dimensionierung der Variablen
    46. Dim arg As String
    47. 'Sicherstellen, dass das datei vorhanden ist
    48. If Right(pfad1, 1) <> "\" Then pfad1 = pfad1 & "\"
    49. If Dir(pfad1 & datei1) = "" Then
    50. GetValue = "datei Not Found"
    51. Exit Function
    52. End If
    53. '** Das Argument erstellen
    54. arg2 = "'" & pfad1 & "[" & datei1 & "]" & blatt2 & "'!" & Range(zelle2).Range("A1").Address(, , xlR1C1)
    55. '** Auslesen über Excel4Macro
    56. GetValue2 = ExecuteExcel4Macro(arg2)
    57. End Function

    Klar überschreibt er immer Tabelle1.
    Du hast meine Anweisungen nicht befolgt.
    Nimm den Originalcode und modifiziere ihn wie beschrieben.
    Dann kopierst du diesen Code 1:1 in Tabelle2.
    Und im Event rufst du die Methoden in beiden Modulen aus.

    Denke objektorientiert.
    Jedes Tabellenblattobjekt hat seine eigenen Methoden und sorgt nur für sich selbst.
    Mal abgesehen von der Event-Routine, die die Methode im Nachbarblatt zusätzlich antriggert.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --
    Hallo
    Also ich habe jetzt beide Codes in der jeweiligen Tabelle drin.

    Ich habe momentan einfach ActiveSheet durch Tabell1 ersetzt.
    Wenn ich jetzt beide Prozeduren einzeln aufrufe funktioniert es, aber irgendwie nicht zusammen.
    Wenn ich wie du gesagt hast einfach

    Visual Basic-Quellcode

    1. Sub Schaltfläche2_Klicken()
    2. Modul1.Bereich_auslesen1
    3. Modul2.Bereich_auslesen2
    4. End Sub


    Er läd die erste Tabelle rein und beim laden der 2 Tabelle überschreibt er die erste mit A, B, C, D.... aber schreibt es in der 2 Tabelle richtig rein.
    der Code für Bereich auslesen2 ist identisch nur statt Tabelle1 wurde Tabelle2 genommen

    Visual Basic-Quellcode

    1. Sub Bereich_auslesen1()
    2. '** Dimensionierung der Variablen
    3. Dim pfad As String, datei As String, blatt As String, bereich As Range, zelle As Object
    4. '** Angaben zur auszulesenden Zelle
    5. pfad = "C:\Users\nussbaum\Desktop\HFG\Produktion\Tools und Programme\Datenauswertung"
    6. datei = "Oberflaeche_Laser.xlsm"
    7. blatt = "Oberflaeche"
    8. Range("J2").FormulaArray = "=MAX(ROW(1:65535)*('[" & datei & "]" & blatt & "'!A1:A65535<>""""))"
    9. Set bereich = Range("A3:H" & Range("J2").Value)
    10. '** Bereich auslesen
    11. For Each zelle In bereich
    12. '** Zellen umwandeln
    13. zelle = zelle.Address(False, False)
    14. '** Eintragen in Bereich
    15. Tabelle1.Cells(zelle.Row, zelle.Column).Value = GetValue(pfad, datei, blatt, zelle)
    16. Next zelle
    17. End Sub
    18. Private Function GetValue(pfad, datei, blatt, zelle)
    19. '** Daten aus geschlossener Arbeitsmappe auslesen
    20. '*** Dimensionierung der Variablen
    21. Dim arg As String
    22. 'Sicherstellen, dass das datei vorhanden ist
    23. If Right(pfad, 1) <> "\" Then pfad = pfad & "\"
    24. If Dir(pfad & datei) = "" Then
    25. GetValue = "datei Not Found"
    26. Exit Function
    27. End If
    28. '** Das Argument erstellen
    29. arg = "'" & pfad & "[" & datei & "]" & blatt & "'!" & Range(zelle).Range("A1").Address(, , xlR1C1)
    30. '** Auslesen über Excel4Macro
    31. GetValue = ExecuteExcel4Macro(arg)
    32. End Function

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „TeamBob“ ()

    TeamBob schrieb:

    Tabelle1.Cells(zelle.Row, zelle.Column).Value = GetValue(pfad, datei, blatt, zelle)
    Du hast doch noch immer Tabelle1. drin stehen.
    Lösch das komplett raus, dann adressiert er relativ zu dem Sheet, in dem der Code steht.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --
    Also er füllt immernoch die erste Tabelle korrekt aus und wenn er die zweite Tabelle befüllen will, dann füllt er die erste und zweite Tabelle mit den Daten
    und überschreibt somit die erste Tabelle.

    Code von Tabelle 2

    Visual Basic-Quellcode

    1. Sub Bereich_auslesen2()
    2. '** Dimensionierung der Variablen
    3. Dim pfad As String, datei As String, blatt As String, bereich As Range, zelle As Object
    4. '** Angaben zur auszulesenden Zelle
    5. pfad = "C:\Users\nussbaum\Desktop\HFG\Produktion\Tools und Programme\Datenauswertung"
    6. datei = "Oberflaeche_Laser.xlsm"
    7. blatt = "Laser"
    8. Range("J2").FormulaArray = "=MAX(ROW(1:65535)*('[" & datei & "]" & blatt & "'!A1:A65535<>""""))"
    9. Set bereich = Range("A3:H" & Range("J2").Value)
    10. '** Bereich auslesen
    11. For Each zelle In bereich
    12. '** Zellen umwandeln
    13. zelle = zelle.Address(False, False)
    14. '** Eintragen in Bereich
    15. Cells(zelle.Row, zelle.Column).Value = GetValue(pfad, datei, blatt, zelle)
    16. Next zelle
    17. End Sub
    18. Private Function GetValue(pfad, datei, blatt, zelle)
    19. '** Daten aus geschlossener Arbeitsmappe auslesen
    20. '*** Dimensionierung der Variablen
    21. Dim arg As String
    22. 'Sicherstellen, dass das datei vorhanden ist
    23. If Right(pfad, 1) <> "\" Then pfad = pfad & "\"
    24. If Dir(pfad & datei) = "" Then
    25. GetValue = "datei Not Found"
    26. Exit Function
    27. End If
    28. '** Das Argument erstellen
    29. arg = "'" & pfad & "[" & datei & "]" & blatt & "'!" & Range(zelle).Range("A1").Address(, , xlR1C1)
    30. '** Auslesen über Excel4Macro
    31. GetValue = ExecuteExcel4Macro(arg)
    32. End Function


    Code von Tabelle 1

    Visual Basic-Quellcode

    1. Sub Bereich_auslesen1()
    2. '** Dimensionierung der Variablen
    3. Dim pfad As String, datei As String, blatt As String, bereich As Range, zelle As Object
    4. '** Angaben zur auszulesenden Zelle
    5. pfad = "C:\Users\nussbaum\Desktop\HFG\Produktion\Tools und Programme\Datenauswertung"
    6. datei = "Oberflaeche_Laser.xlsm"
    7. blatt = "Oberflaeche"
    8. Range("J2").FormulaArray = "=MAX(ROW(1:65535)*('[" & datei & "]" & blatt & "'!A1:A65535<>""""))"
    9. Set bereich = Range("A3:H" & Range("J2").Value)
    10. '** Bereich auslesen
    11. For Each zelle In bereich
    12. '** Zellen umwandeln
    13. zelle = zelle.Address(False, False)
    14. '** Eintragen in Bereich
    15. Cells(zelle.Row, zelle.Column).Value = GetValue(pfad, datei, blatt, zelle)
    16. Next zelle
    17. End Sub
    18. Private Function GetValue(pfad, datei, blatt, zelle)
    19. '** Daten aus geschlossener Arbeitsmappe auslesen
    20. '*** Dimensionierung der Variablen
    21. Dim arg As String
    22. 'Sicherstellen, dass das datei vorhanden ist
    23. If Right(pfad, 1) <> "\" Then pfad = pfad & "\"
    24. If Dir(pfad & datei) = "" Then
    25. GetValue = "datei Not Found"
    26. Exit Function
    27. End If
    28. '** Das Argument erstellen
    29. arg = "'" & pfad & "[" & datei & "]" & blatt & "'!" & Range(zelle).Range("A1").Address(, , xlR1C1)
    30. '** Auslesen über Excel4Macro
    31. GetValue = ExecuteExcel4Macro(arg)
    32. End Function