Cleancode oder DB einfach zu groß?
26.02.2014 08:50:35
maik
ich habe eine Datenbank von etwa 207.000 Zeilen bei 7 Spalten
diese werden durchsucht und in unterschiedliche sheets aufgelistet, gemäß dem code:
sub lala wird aufgerufen
Sub lala()
Sheets(1).Select
Sheets(1).Cells.Clear
Dim b As Integer
For b = 3 To 565
Sheets(b).Select
Range("A1:H30000").Select
Selection.ClearContents
Next b
Sheets(1).Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\xxx\Desktop\test.csv", Destination:=Range( _
"$A$1"))
.Name = "Nichts verändern"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 65000
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
'Columns("A:A").Select
'Range("A9999").Activate
'Selection.NumberFormat = "dd.mm.yyyy"
'Columns("B:B").Select
'Range("B9999").Activate
'Selection.NumberFormat = "@"
' Columns("C:C").Select
' Range("C9999").Activate
'Selection.NumberFormat = "@"
'Columns("D:D").Select
' Range("D9999").Activate
'Selection.NumberFormat = "@"
' Columns("E:E").Select
' Range("E9999").Activate
'Selection.NumberFormat = "@"
' Columns("F:F").Select
' Range("F9999").Activate
' Selection.NumberFormat = "@"
'Columns("G:G").Select
' Range("G9999").Activate
'Selection.NumberFormat = "@"
Sheets(2).Select
Call Makro1
Sheets(2).Select
End Sub
Sub Makro1()
Dim a As Integer
For a = 3 To 565
Sheets(a).Select
Call aaa
Range("H2").Select
ActiveCell.Value = WorksheetFunction.Sum(Columns(7))
Next a
End Sub
Sub aaa()
Dim oDaten As Variant, arrTmp As Variant
Dim arrDaten() As Variant
Dim i As Long, J As Integer, n As Long
Dim arrItems As Variant
Dim x As Long
Dim mysht As Variant
mysht = ActiveSheet.Range("I1")
Sheets(1).Cells(1, 9) = mysht
Set oDaten = CreateObject("scripting.Dictionary")
arrTmp = Sheets(1).Cells(1, 1).CurrentRegion
oDaten(1) = WorksheetFunction.Index(arrTmp, 1)
For x = 1 To 7 'durchläuft Spalte 1-7
For i = 2 To UBound(arrTmp)
If arrTmp(i, x) = Sheets(1).Cells(1, 9) Then
oDaten(i) = WorksheetFunction.Index(arrTmp, i)
End If
Next i
Next x
ReDim arrDaten(1 To oDaten.Count, 1 To 7)
arrItems = oDaten.items
For i = 0 To UBound(arrItems)
n = n + 1
For J = 1 To 7
arrDaten(n, J) = arrItems(i)(J)
Next
Next
With ActiveSheet 'Sheets(mysht)
.Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)).Resize(, 7).ClearContents
.Cells(1, 1).Resize(UBound(arrDaten), 7) = arrDaten
End With
End Sub
mein problem, bei dem ausführen bekomme ich folgenden fehler:
Laufzeitfehler '12' Typen unverträglich.
Klicke ich auf debuggen wird folgende zeile gelb dargestellt:
oDaten(1) = WorksheetFunction.Index(arrTmp, 1)
wenn die Datenbank nicht so groß ist, z.B. nur 1500 zeilen auf 7 spalten funktioniert alles tadellos.. braucht nur halt sehr lange.
ich kann den code halt nicht gut beurteilen, evtl. ist der einfach nur sau mies geschrieben, sodass excell dafür ewig braucht, oder komme ich einfach nur an die grenze von excel?
die variablen odaten x,j,i,... habe ich auch schonmal einen anderen typ zugeordnet, hat auch nicht viel gebracht.
wäre schön, wenn ihr eine idee für mich habt, woran das liegt, bzw. wie ich es lauffähig bekomme