Hallo Forum,
bitte um dringende Hilfe. Kann mir einer bei unten stehenden Code weiterhelfen?
Bzw. diesen Code in normale Menschensprachen übersetzen...
Sub Update_DS()
Dim DB As Database
Dim index As DAO.Recordset, records As DAO.Recordset
Dim query As QueryDef
Dim message As String, QueryName As String, SQL As String
Dim varStatus As Variant
Dim ThisInput As Variant, ThisOutput As Variant, ThisKennung As Variant
Dim i As Single, j As Single, MaxRow As Single, MaxCol As Single
Dim xl As Object
Set DB = OpenDatabase(CurrentDb.Name)
Set index = DB.OpenRecordset("DS_Index")
i = 1
With index
.MoveLast
ReDim ThisInput(1 To .RecordCount, 1 To 10)
ReDim ThisKennung(1 To .RecordCount, 1 To 2)
.MoveFirst
While .EOF = False
message = .fields("SeriesTicker") ' status ausgabe
Debug.Print message
varStatus = SysCmd(acSysCmdSetStatus, message)
DoEvents
SQL = "SELECT * FROM DS_Data WHERE Kennung = " & .fields("Kennung") & " ORDER BY Datum"
Set records = DB.OpenRecordset(SQL)
If records.RecordCount = 0 Then ' check, ob query da
QueryName = "DS_" & .fields("Category") & "_" & .fields("Land") & "_" & _
.fields("LevelRateChng") & "_" & VBA.Format(.fields("Kennung"), "0000")
If Not QueryExists(QueryName) Then
Set query = DB.CreateQueryDef(QueryName, SQL) 'Query wird initialisiert
End If
End If
ThisInput(i, 1) = "YES"
ThisInput(i, 2) = "TS"
ThisInput(i, 3) = "RCF"
ThisInput(i, 4) = .fields("SeriesTicker")
ThisInput(i, 5) = .fields("DataType")
ThisInput(i, 6) = #1/1/1950#
ThisInput(i, 8) = .fields("Frequency")
ThisInput(i, 10) = "=""Alldata!"" & ADDRESS(1, (ROW(A" & (i + 6) & ")-6)*2, 4)"
ThisKennung(i, 1) = .fields("Kennung")
ThisKennung(i, 2) = .fields("Publishing Lag (Weeks)")
i = i + 1
.MoveNext
Wend
End With
Set index = Nothing
Set xl = CreateObject("excel.application")
xl.Visible = True
xl.Workbooks.Open FileName:="F:\Bonds\ProjektemiteinergewissenTragweite\AssetAlloc\THE_BIG_MACRO_DATABASE\DS\Request.xlsm"
xl.Sheets("REQUEST_TABLE").Activate
xl.Sheets("REQUEST_TABLE").Select
xl.worksheets("REQUEST_TABLE").range("B7:U20000").clearcontents
xl.worksheets("REQUEST_TABLE").range("B7:U20000").clearformats
xl.worksheets("REQUEST_TABLE").range(xl.cells(7, 2), xl.cells(UBound(ThisInput) + 6, 12)) = ThisInput
xl.worksheets("Alldata").range("A1:XFD100000").clearcontents
xl.worksheets("Alldata").range("A1:XFD100000").clearformats
xl.Run ("StartProcessingRT")
DoEvents
xl.worksheets("REQUEST_TABLE").range("B7:K" & UBound(ThisInput) + 6) = ThisInput
xl.worksheets("Alldata").Activate
xl.worksheets("Alldata").range("B1").Select
Const xlFormulas As Integer = -4123
Const xlPart As Integer = 2
Const xlByRows As Integer = 1
Const xlNext As Integer = 1
Const xlByColumns As Integer = 2
Const xlPrevious As Integer = 2
MaxRow = 10000
MaxCol = xl.cells.Find(What:="*", After:=xl.cells(1, 1), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
Set index = DB.OpenRecordset("DS_Data")
With index
For i = 2 To MaxCol Step 2
ThisOutput = xl.worksheets("Alldata").range(xl.cells(1, i), xl.cells(20000, i + 1))
If Not ThisOutput(1, 2) = "#Error" Then
SQL = "DELETE * FROM DS_Data WHERE Kennung = " & ThisKennung(i / 2, 1)
DB.Execute (SQL)
message = "Writing " & ThisInput(i / 2, 4) & " that is " & (i / 2) & " of " & ((MaxCol - 1) / 2)
Debug.Print message
varStatus = SysCmd(acSysCmdSetStatus, message)
DoEvents
For j = 3 To UBound(ThisOutput)
If ThisOutput(j, 1) = "" Then
Exit For
Else
If Not ThisOutput(j, 2) = "NA" Then
.AddNew
.fields("Kennung") = ThisKennung(i / 2, 1)
.fields("Datum") = ThisOutput(j, 1)
.fields("Combined Date") = ThisOutput(j, 1) + ThisKennung(i / 2, 2) * 7
.fields("Combined Value") = ThisOutput(j, 2)
.update
End If
End If
Next j
End If
Next i
End With
Set index = Nothing
xl.activeWorkbook.Save
xl.activeWorkbook.Close
xl.Quit
Set xl = Nothing
End Sub
|