21.11.2016, 11:54
(Dieser Beitrag wurde zuletzt bearbeitet: 24.11.2016, 14:20 von Rabe.
Bearbeitungsgrund: Code in Code-Tags gesetzt
)
Hallo,
ich habe ein Auswertungsprogramm für eine Tabelle geschrieben. Diese spiegelt eine Ordnerstruktur mit Dokumenten wieder.
Eine Auswertung wäre, alle Dokumente mit ungerader Versionsnummer herauszufinden. Diese werden, wenn gefunden, mit einem Kommentar versehen wer das Dokument zuletzt bearbeitet hat und zudem werden sowohl der Ordner in dem das Dokument online liegt, als auch das Dokument selber direkt über einen Hyperlink versehen.
Das ganze funktioniert auch schon sehr gut, hat aber bei 50.000 schon eine Bemerkenswerte Ladezeit.
Ich glaube man kann über eine andere Herangehensweise, anstatt wie ich über Hilfstabellen in Excel selbst, die Auswertung stark beschleunigen. Ähnlich wie in dem Prozess des Hyperlink unterlegens. Ich habe einmal eine Beispieldatei erstellt, hier noch einmal die Formel um die es grundlegend geht:
Ich freue mich über jede Hilfe,
Liebe Grüße!
ich habe ein Auswertungsprogramm für eine Tabelle geschrieben. Diese spiegelt eine Ordnerstruktur mit Dokumenten wieder.
Eine Auswertung wäre, alle Dokumente mit ungerader Versionsnummer herauszufinden. Diese werden, wenn gefunden, mit einem Kommentar versehen wer das Dokument zuletzt bearbeitet hat und zudem werden sowohl der Ordner in dem das Dokument online liegt, als auch das Dokument selber direkt über einen Hyperlink versehen.
Das ganze funktioniert auch schon sehr gut, hat aber bei 50.000 schon eine Bemerkenswerte Ladezeit.
Ich glaube man kann über eine andere Herangehensweise, anstatt wie ich über Hilfstabellen in Excel selbst, die Auswertung stark beschleunigen. Ähnlich wie in dem Prozess des Hyperlink unterlegens. Ich habe einmal eine Beispieldatei erstellt, hier noch einmal die Formel um die es grundlegend geht:
Code:
' Einfügen der Berechnungstabelle aus den Ausgangsdaten von Wrongversion
Worksheets("WrongVersion").Select
Range("D8").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(IF(OR(LEN(Tabelle1!R[-6]C[19])>3,MOD(Tabelle1!R[-6]C[19],1)>0),Tabelle1!R[-6]C[16]&""_""&Tabelle1!R[-6]C[19],0),Tabelle1!R[-6]C[16]&""_""&Tabelle1!R[-6]C[19])"
Selection.AutoFill Destination:=Range("D8: D" & LaengeGes + 8), Type:=xlFillDefault
'''' Die Formel hier drüber ist hauptsächlich gemeint''''
' Aus den gefundenen Dokumenten Hyperlinks machen
For count = 0 To LaengeGes
With Worksheets("WrongVersion")
If .Cells(8 + count, 4).Value <> 0 Then
'Hyperlink Dokument
.Hyperlinks.Add Anchor:=.Cells(8 + count, 5), _
Address:="https://testurl/" & Worksheets("Tabelle1").Cells(2 + count, 19), _
TextToDisplay:=.Cells(8 + count, 4).Value
'Hyperlink Ordner
.Hyperlinks.Add Anchor:=.Cells(8 + count, 6), _
Address:="https://testurl/" & Worksheets("Tabelle1").Cells(2 + count, 8), _
TextToDisplay:=Worksheets("Tabelle1").Cells(2 + count, 9).Value
End If
End With
Next count
' Hier wird angegeben, wer das Dokument zuletzt bearbeitet hat
For count = 0 To LaengeGes
With Worksheets("WrongVersion")
If .Cells(8 + count, 4).Value <> 0 Then
With .Cells(8 + count, 5)
.AddComment
.Comment.Text Text:="Last modified by:" & Worksheets("Tabelle1").Cells(2 + count, 25)
End With
End If
End With
Next count
' Sortieren der gefundenen Daten
ActiveWorkbook.Worksheets("WrongVersion").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("WrongVersion").Sort.SortFields.Add Key:=Range("E8" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("WrongVersion").Sort
.SetRange Range("E8:F" & LaengeGes)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
' Anzahl gefundener falscher Versionen
LengthVersion = Sheets("WrongVersion").Range("I7").Value
' Beschriftung Ausgabeseite Wrong Version
Range("Tabelle4!B" & rngOverall1 + 2).Value = "List of Documents with wrong Versions"
' Range("Tabelle4!B" & rngOverall1 + 2).Select
' Selection.Font.Underline = xlUnderlineStyleSingle
Range("Tabelle4!B" & rngOverall1 + 3).Value = "Number of the 'Wrong Version Documents'=" & LengthVersion
Range("Tabelle4!F" & rngOverall1 + 3).Value = "A total of:" & LaengeGes & " Documents"
' Range("Tabelle4!B" & rngOverall1 + 3).Select
' Selection.Font.Underline = xlUnderlineStyleSingle
' Gefundene Daten aus Berechnungsblatt kopieren und in Ergebnisblatt ausgeben
'Ordner einfügen
Sheets("WrongVersion").Select
Range("F8:F" & LengthVersion + 7).Select
Selection.Copy
Sheets("Tabelle4").Select
Range("B" & rngOverall1 + 5).Select
ActiveSheet.Paste
'Dokument einfügen
Sheets("WrongVersion").Select
Range("E8:E" & LengthVersion + 7).Select
Selection.Copy
Sheets("Tabelle4").Select
Range("F" & rngOverall1 + 5).Select
ActiveSheet.Paste
rngOverall1 = rngOverall1 + LengthVersion + 7
rngOverall2 = rngOverall2 + LengthVersion + 7
Ich freue mich über jede Hilfe,
Liebe Grüße!