Schleife möglich ?

  • Excel

Es gibt 6 Antworten in diesem Thema. Der letzte Beitrag () ist von the_racer.

    Schleife möglich ?

    Hallo zusammen.
    Ich habe folgendes Problem und hoffe, mir kann hier geholfen werden, oder zumindest eine Antwort ob´s machbar ist oder nicht gegeben werden.

    Folgendes.
    Ich möchte in Excel externe Daten einlesen, die aus HTML-Dokumenten stammen. Dies habe ich soweit auch über die Webabfrage hinbekommen. Ich habe ein Makro geschrieben (oder besser, über den Rekorder aufgenommen), was mir dies ermöglicht.

    Jetzt das Problem. Diese HTML-Dateien sind durchnummeriert. Sie heißen z.B. Datensatz_001.html, Datensatz_002.html, Datensatz_003.html usw. Bis hin zu knapp 900 Datensätzen, die sich alle drei Tage ändern, ich sie also wieder neu einlesen muß.

    So der Text zum einlesen:

    With ActiveSheet.QueryTables.Add(Connection:= _
    "URL;file:///D:/Daten/Datensatz_001.html" _
    , Destination:=Range("A1"))
    .Name = "Datensatz_001"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlEntirePage
    .WebFormatting = xlWebFormattingNone

    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
    End With
    ...

    Jetzt will ich natürlich nicht 999 Sub´s schreiben, die für jeden einzelnen Datensatz funktionieren.

    Kann man da vielleicht eine Schleife einbauen, die die Datensätze alle einbezieht ?
    Ich hoffe, Ihr versteht was ich meine und könnt mir helfen !

    Schon jetzt vielen Dank dafür !

    Gruß
    Thomas

    So müsste es prinzipiell funktionieren:

    Visual Basic-Quellcode

    1. For i = 1 To 900
    2. With ActiveSheet.QueryTables.Add(Connection:= _
    3. "URL;file:///D:/Daten/Datensatz_" & Format(i, "000") & ".html" _
    4. , Destination:=Range("A1"))
    5. .Name = "Datensatz_" & Format(i, "000")
    6. .FieldNames = True
    7. .RowNumbers = False
    8. .FillAdjacentFormulas = False
    9. .PreserveFormatting = True
    10. .RefreshOnFileOpen = False
    11. .BackgroundQuery = True
    12. .RefreshStyle = xlInsertDeleteCells
    13. .SavePassword = False
    14. .SaveData = True
    15. .AdjustColumnWidth = True
    16. .RefreshPeriod = 0
    17. .WebSelectionType = xlEntirePage
    18. .WebFormatting = xlWebFormattingNone
    20. .WebPreFormattedTextToColumns = True
    21. .WebConsecutiveDelimitersAsOne = True
    22. .WebSingleBlockTextImport = False
    23. .WebDisableDateRecognition = False
    24. .WebDisableRedirections = False
    25. .Refresh BackgroundQuery:=False
    26. End With
    27. Next


    Bei "Destination:=" hab ich mal noch nichts verändert, da ich nicht weiß, was da dann pro HTML-Datei alles reinkommt.

    Okay, ob´s funktioniert, kann ich noch nicht sagen, weil jetzt folgendes Problem aufgetreten ist...
    Nach dem einlesen der Daten sollen alle Leerzeilen gelöscht werden. Das habe ich bisher so gelöst:

    Visual Basic-Quellcode

    1. Selection.ClearContents
    3. Dim i As Long, laR As Long
    4. Application.ScreenUpdating = False
    5. laR = Cells(Rows.Count, 1).End(xlUp).Row
    6. For i = laR To 1 Step -1
    7. If Cells(i, 1).Value = "" Then
    8. Cells(i, 1).EntireRow.Delete
    9. End If
    10. Next i
    11. Application.ScreenUpdating = True


    Bei jedem Datensatz als eigenständiges Sub hat es funktioniert, jetzt bekomme ich folgende Fehlermeldung noch vor dem ausführen:
    Fehler beim Kompilieren:Mehrfachdeklaration im aktuellen Gültigkeitsbereich
    :(

    Hier jetzt mal der ganze Quelltext, ich denke, das macht die Sache hoffentlich klarer. Dein Vorschlag ist schon eingearbeitet:

    Visual Basic-Quellcode

    1. Sub Einlesen_Datensaetze()
    2. '
    3. ' Einlesen_Datensaetze Makro
    5. 'Datenblätter vorbereiten (einmalig)
    7. Sheets("Tabelle1").Select
    8. Sheets("Tabelle1").Name = "RohMat"
    9. Sheets("Tabelle2").Select
    10. Sheets("Tabelle2").Name = "Ausgewertet"
    11. Sheets("RohMat").Select
    13. Sheets("Ausgewertet").Select
    14. Range("A1").Select
    15. ActiveCell.FormulaR1C1 = "Name"
    16. Range("B1").Select
    17. ActiveCell.FormulaR1C1 = "Einnahme"
    18. Range("C1").Select
    19. ActiveCell.FormulaR1C1 = "Differenz Vormonat"
    20. Range("D1").Select
    21. ActiveCell.FormulaR1C1 = "Abschlüsse"
    22. Range("E1").Select
    23. ActiveCell.FormulaR1C1 = "Vormonat"
    24. Range("F1").Select
    25. ActiveCell.FormulaR1C1 = "Gesamtbilanz I"
    26. Range("G1").Select
    27. ActiveCell.FormulaR1C1 = "Gesamtbilanz II"
    28. Range("A2").Select
    29. Sheets("RohMat").Select
    31. 'Datenabfrage
    33. For i = 1 To 900
    35. Range("B12").Select
    36. With ActiveSheet.QueryTables.Add(Connection:= _
    37. "URL;file:///D:/Daten/Datensatz_" & Format(i, "000") & ".html" _
    38. , Destination:=Range("A1"))
    39. .Name = "Datensatz_" & Format(i, "000")
    40. .FieldNames = True
    41. .RowNumbers = False
    42. .FillAdjacentFormulas = False
    43. .PreserveFormatting = True
    44. .RefreshOnFileOpen = False
    45. .BackgroundQuery = True
    46. .RefreshStyle = xlInsertDeleteCells
    47. .SavePassword = False
    48. .SaveData = True
    49. .AdjustColumnWidth = True
    50. .RefreshPeriod = 0
    51. .WebSelectionType = xlEntirePage
    52. .WebFormatting = xlWebFormattingNone
    54. .WebPreFormattedTextToColumns = True
    55. .WebConsecutiveDelimitersAsOne = True
    56. .WebSingleBlockTextImport = False
    57. .WebDisableDateRecognition = False
    58. .WebDisableRedirections = False
    59. .Refresh BackgroundQuery:=False
    60. End With
    62. Selection.ClearContents
    64. Dim i As Long, laR As Long
    65. Application.ScreenUpdating = False
    66. laR = Cells(Rows.Count, 1).End(xlUp).Row
    67. For i = laR To 1 Step -1
    68. If Cells(i, 1).Value = "" Then
    69. Cells(i, 1).EntireRow.Delete
    70. End If
    71. Next i
    72. Application.ScreenUpdating = True
    74. 'Werte in Tabelle bringen
    76. Sheets("RohMat").Select
    77. Range("A2").Select
    78. Selection.Copy
    79. Sheets("Ausgewertet").Select
    80. Range("A2").Select
    81. ActiveSheet.Paste
    82. Sheets("RohMat").Select
    83. Range("B8").Select
    84. Application.CutCopyMode = False
    85. Selection.Copy
    86. Sheets("Ausgewertet").Select
    87. Range("B2").Select
    88. ActiveSheet.Paste
    89. Sheets("RohMat").Select
    90. Range("A4").Select
    91. Application.CutCopyMode = False
    92. Selection.Copy
    93. Sheets("Ausgewertet").Select
    94. Range("C2").Select
    95. ActiveSheet.Paste
    96. Sheets("RohMat").Select
    97. Range("B14").Select
    98. Application.CutCopyMode = False
    99. Selection.Copy
    100. Sheets("Ausgewertet").Select
    101. Range("D2").Select
    102. ActiveSheet.Paste
    103. Sheets("RohMat").Select
    104. Range("D14").Select
    105. Application.CutCopyMode = False
    106. Selection.Copy
    107. Sheets("Ausgewertet").Select
    108. Range("E2").Select
    109. ActiveSheet.Paste
    110. Sheets("RohMat").Select
    111. Range("A4").Select
    112. Application.CutCopyMode = False
    113. Selection.Copy
    114. Sheets("Ausgewertet").Select
    115. Range("F2").Select
    116. ActiveSheet.Paste
    117. Sheets("RohMat").Select
    118. Range("B11").Select
    119. Application.CutCopyMode = False
    120. Selection.Copy
    121. Sheets("Ausgewertet").Select
    122. Range("G2").Select
    123. ActiveSheet.Paste
    124. Range("A3").Select
    125. Rows("2:2").Select
    126. Selection.Insert Shift:=xlDown
    127. Sheets("RohMat").Select
    128. Range("B12").Select
    130. 'Rohblatt löschen
    132. Sheets("RohMat").Select
    133. Range("B12").Select
    134. Cells.Select
    135. Application.CutCopyMode = False
    136. Selection.ClearContents
    137. Selection.QueryTable.Delete
    138. Range("B12").Select
    140. Next
    142. End Sub


    So, vielleicht bringt Euch das weiter... ;(

    Aaaaaaaaaah..... :)
    Die besten Fehler sind die, die man selber lösen kann. :)

    Der Fehler lag wohl in der doppelten Vergabe der Variable "i". :)
    Dim i As Long, laR As Long
    Mensch, Mensch. Jetzt geht´s mit einer anderen Variable tatsächlich !

    Nochmal vielen, vielen Dank für Deine Hilfe !!! *verneig*

    Freut mich, dass ich dir helfen konnte, aber du brauchst dich doch nicht verneigen. Ist ja nur ne For-Schleife. ^^ Obwohl: Es gab auch Zeiten, wo ich aufgezeichneten Code sooft kopiert hab, wie er ausgeführt werden soll. Da wusste ich von den For-Schleifen noch nichts. Das ging dann teilweise soweit, dass der Code so lang geworden ist, dass vor dem Ausführen eine Fehlermeldung kam, dass der Code zu lang sei. Wie lang der da war, weiß ich nicht mehr. Ist auch schon einige Zeit her.

    Jetzt jedoch genug davon und zur Sache:

    Ich hab mir deinen Code mal angesehen und habe ein paar Verbesserungsvorschläge:

    1. Du musst nicht unbedingt eine Zelle auswählen, um etwas reinzuschreiben.

    Statt dem hier

    Visual Basic-Quellcode

    1. Range("A1").Select
    2. ActiveCell.FormulaR1C1 = "Name"


    kannst du auch das schreiben:

    Visual Basic-Quellcode

    1. Range("A1").FormulaR1C1 = "Name"


    und wenn es keine Formel ist, sogar das:

    Visual Basic-Quellcode

    1. Range("A1") = "Name"



    2. Du kannst Werte auch direkt von Zelle nach Zelle übertragen:

    Statt diesem hier

    Visual Basic-Quellcode

    1. Sheets("RohMat").Select
    2. Range("A2").Select
    3. Selection.Copy
    4. Sheets("Ausgewertet").Select
    5. Range("A2").Select
    6. ActiveSheet.Paste


    kannst du auch das schreiben:

    Visual Basic-Quellcode

    1. Sheets("Ausgewertet").Range("A2") = Sheets("RohMat").Range("A2")


    Jedoch werden dann nur die Werte übertragen; Formatierungen (auch Zahlenformate) werden nicht übergeben.

    Willst du es doch kopieren, kann man obigen Code hierzu verkürzen:

    Visual Basic-Quellcode

    1. Sheets("RohMat").Range("A2").Copy
    2. Sheets("Ausgewertet").Select
    3. Range("A2").Select
    4. ActiveSheet.Paste



    3. Wenn du magst, kannst du auch die Tabellenblätter mit Variablen ansprechen.

    Statt diesem hier

    Visual Basic-Quellcode

    1. Sheets("Tabelle1").Select
    2. Sheets("Tabelle1").Name = "RohMat"
    3. Sheets("Tabelle2").Select
    4. Sheets("Tabelle2").Name = "Ausgewertet"
    5. Sheets("RohMat").Select


    kannst du z. B. das machen:

    Visual Basic-Quellcode

    1. Dim RohMat As Worksheet, Ausgew As Worksheet
    3. Set RohMat = Sheets("Tabelle1")
    4. Set Ausgew = Sheets("Tabelle2")
    5. RohMat.Name = "RohMat"
    6. Ausgew.Name = "Ausgewertet"
    7. RohMat.Select



    Das bei 3. ist halt mein Programmierstil. Ich habe mir angewöhnt, dass ich die Tabellen Variablen zuweise. Auf diese Weise brauche ich nur die Variable hinschreiben, auch wenn ich z. B. in eine andere Mappe gewechselt bin. Ich brauche dann beispielsweise nicht "Workbooks("Mappe1.xls").Sheets("Tabelle1")" schreiben, sondern nur "Tab", wenn ich die Variable "Tab" genannt habe. Außerdem kann ich so sicher gehen, dass ich auf die richtige Tabelle zugreife.

    In deinem Fall funktioniert es mit "Sheets("...")" genausogut, denke ich. Ich wollte nur eine Alternative aufzeigen.


    EDIT:

    Noch eine Anmerkung zu meinen Vorschlägen:

    Dem Code sehe ich an, dass du größtenteils den Code so gelassen hast, wie er aufgezeichnet wurde. Was auch okay ist, solange es funktioniert. Ich wollte nur zeigen, dass, wenn du weitere ähnliche Abläufe programmierst, der Code dann nicht unbedingt genauso sein muss wie durch die Aufzeichnung.

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „roddy“ ()

    Wow, irre. :)
    Das der Code, der beim direkten Aufzeichen generiert wird, nicht der optimalste ist, ist ja eigentlich ausser Frage. Bill Gates´ Style eben. *g*
    Und Deine Tipps habe ich bereits beherzigt und umgesetzt, vielen Dank dafür !
    Ich werde mich jetzt wohl näher mit dem direkten programmieren befassen, das schwebt mit schon lange vor. Ich werde Dich mal als "F1-Hilfe-Taste" speichern ! :)