Hi Leute,
nach mehereren Nächten Googlen wende ich mich nun an Euch, vielleicht könnt Ihr mir helfen.
Ich habe Performance Probleme bei einem Makro das Webabfragen aus dem Netz macht.
Erstes Problem, ich speicher nach jeder Webabfrage mein Workbook und manchmal ganz unmotiviert fragt mich Excel ein SpeichernUnter mit einer lustigen Nummer als Filenamen, wenn ich okay drücke läuft das Makro weiter, wenn ich den Namen ändere dann kommt ein Laufzeitfehler 1004.
Zur Zeit habe ich das Speichern auskommentiert.
Zweites Problem, steigt die Anzahl der Webabfragen über 400 dann wird mein Rechner wirklich sehr langsam, obwohl die Datenmengen eher bescheiden sind die ich in mein Worksheet kopiere. Mein Rechner ist eher eine flotte Motte als ein alter Opa, Hauptspeicher 2G und mein System läuft auf XP, Internetverbindung ist super schnell, der Server von dem ich die Daten hole ist eher langsam.
Kennt Ihr auch solche Probleme oder habe ich einfach irgendetwas vergessen oder eher nicht sauber programmiert.
Danke für Eure Hilfe und LG
saubermacher
Anbei ein Auszug aus meinem Makro:
===========================================================================
For zeilen = startzeile To letztezeile
sQuery = ""
wkn = 0
firma = Worksheets(Daten).Cells(zeilen, firma_spalte).Value
Worksheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = firma
sQuery = "http://member.corporateinformation.com/snapshot.asp?CUSIP="
cusip = Worksheets(Daten).Cells(zeilen, cusip_spalte)
sQuery = sQuery & cusip & "&Sentby=Home"
Worksheets.Add After:=Worksheets(Worksheets.Count)
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://member.corporateinformation.com/snapshot.asp?CUSIP=" & cusip & "&Sentby=Home", _
Destination:=Range("A1"))
.Name = "snapshot.asp?CUSIP=" & cusip & "&Sentby=Home"
.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
ActiveSheet.Name = "profile"
profile = ActiveWorkbook.Sheets("profile").Name
stack1 = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
stack2 = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
For delcountx = 1 To stack2
For delcounty = 1 To stack1
If Worksheets(profile).Cells(delcounty, delcountx).Value Like "*Market Capitalization:*" Then
Worksheets(firma).Cells(7, 2).Value = Mid(Worksheets(profile).Cells(delcounty, delcountx).Value, 24, Len(Worksheets(profile).Cells(delcounty, delcountx).Value) - 23)
Worksheets(Daten).Cells(zeilen, 7).Value = Worksheets(firma).Cells(7, 2).Value
End If
If Worksheets(profile).Cells(delcounty, delcountx).Value Like "*Currency:*" Then
Worksheets(firma).Cells(8, 2).Value = Mid(Worksheets(profile).Cells(delcounty, delcountx).Value, 11, Len(Worksheets(profile).Cells(delcounty, delcountx).Value) - 10)
Worksheets(Daten).Cells(zeilen, 8).Value = Mid(Worksheets(profile).Cells(delcounty, delcountx).Value, 11, Len(Worksheets(profile).Cells(delcounty, delcountx).Value) - 10)
End If
If Worksheets(profile).Cells(delcounty, delcountx).Value Like "*Fiscal Year Ends:*" Then
Worksheets(firma).Cells(9, 2).Value = Mid(Worksheets(profile).Cells(delcounty, delcountx).Value, 18, Len(Worksheets(profile).Cells(delcounty, delcountx).Value) - 17)
Worksheets(Daten).Cells(zeilen, 9).Value = Mid(Worksheets(profile).Cells(delcounty, delcountx).Value, 18, Len(Worksheets(profile).Cells(delcounty, delcountx).Value) - 17)
End If
If Worksheets(profile).Cells(delcounty, delcountx).Value Like "*):*" Then
datumc = Len(Worksheets(profile).Cells(delcounty, delcountx).Value)
For datumc1 = datumc - 1 To 1 Step -1
datumm = Mid(Worksheets(profile).Cells(delcounty, delcountx).Value, datumc1, 1)
If datumm = " " Then
datuml1 = datumc1
wkurs = Mid(Worksheets(profile).Cells(delcounty, delcountx).Value, datumc1 + 1, datumc - datumc1)
Worksheets(firma).Cells(5, 2).Value = wkurs
Worksheets(Daten).Cells(zeilen, 5).Value = Worksheets(firma).Cells(5, 2).Value
End If
If datumm = ")" Then
datuml2 = datumc1
End If
If datumm = "(" Then
kurs_datum = Mid(Worksheets(profile).Cells(delcounty, delcountx).Value, datumc1 + 1, datuml2 - datumc1 - 1)
Worksheets(firma).Cells(6, 2).Value = kurs_datum
Worksheets(Daten).Cells(zeilen, 6).Value = Worksheets(firma).Cells(6, 2).Value
datumc1 = 0
End If
Next datumc1
End If
Next delcounty
Next delcountx
del = ActiveWorkbook.Sheets.Count
Worksheets(del).Delete
Application.CutCopyMode = False
ActiveSheet.Name = firma
filename = Application.ActiveWorkbook.Name
spath = Application.ActiveWorkbook.Path
'ActiveWorkbook.Save
Next zeilen