AW: Code Optimierung
18.01.2020 09:39:56
Nepumuk
Hallo kocius,
ich habe deinen Code mal ausgemistet:
'sucht Durchführungszeiten zum angegebenem Testfall und speichert diese in einer Tabelle auf dem Tabellenblatt Berechnung
Sub searchandsave()
Dim DatAnfang As Date
DatAnfang = Now
Dim rngZelle As Range, rngBereich As Range
Dim tctime
Dim rowcounter As Long
Dim berzähler As Long
Dim mediantime
'############################################################################Schleife
Dim lr As Long 'lastwrittenrow im Reiter "Statistik" 1 Spalte
Dim rc As Long 'Zeilenzähler
Dim tc As Long 'Zähler für Tesfall-IDs
Dim lngSpalte As Long
Dim a As Long
Dim avntValues As Variant
Dim FirtsSearchTestcaseid As String
'========================NEU Anfang========================
Dim SearchTestcaseid As Range
'========================NEU Ende========================
DisableAppFeedback
'** Spalte, die auf Leerzeichen geprüft werden soll
lngSpalte = 1
avntValues = Range(Cells(2, lngSpalte), Cells(Rows.Count, lngSpalte).End(xlUp)).Value2
For a = UBound(avntValues, 1) To LBound(avntValues, 1) Step -1
If avntValues(a, 1) <= 0 Then Rows(a).delete shift:=xlUp
Next a
lr = GetLastWrittenRowNr("Statistik") 'letzte beschriebene Zeile im Tabellenblatt Statistik
tc = 1 'Zähler für die Zeilennummer in der die berechnete Medianzeit gespeichert wird
Set rngBereich = Worksheets("Auswertung").Range("K:K")
For rc = 2 To lr
'zu durchsuchende Bereich
'Kopieren der Durchführungszeiten die zu einer Testfall-ID gehören
'========================NEU Anfang========================
Set SearchTestcaseid = rngBereich.Find(Worksheets("Statistik").Cells(rc, 1).value)
'wird geprüft, ob der Wert vorhanden ist
If Not SearchTestcaseid Is Nothing Then
FirtsSearchTestcaseid = SearchTestcaseid.Address 'Erste Suche wird gepeichert
Do
berzähler = berzähler + 1
Worksheets("Berechnung").Cells(berzähler, 1).value = _
Worksheets("Auswertung").Cells(SearchTestcaseid.row, 17).value
Set SearchTestcaseid = rngBereich.FindNext(SearchTestcaseid)
Loop Until FirtsSearchTestcaseid = SearchTestcaseid.Address
'========================NEU Ende========================
' For Each rngZelle In rngBereich
' If rngZelle.value = testcaseid Then
' rowcounter = rngZelle.row
' tctime = Worksheets("Auswertung").Cells(rowcounter, 17).value
' Worksheets("Berechnung").Cells(berzähler, 1).value = tctime
'intZähler = intZähler + 1
'berzähler = berzähler + 1
' End If
' Next
'Medianzeit im Tabellenblatt Berechnung berechnen
Worksheets("Statistik").Cells(rc, 3).value = _
WorksheetFunction.Median(Worksheets("Berechnung").Columns(1))
'Tabellenblatt berechnung leeren bevor nächste medianzeit berechnet wird
Worksheets("Berechnung").Columns(1).Clear
End If
Next rc
EnableAppFeedback
MsgBox Format(Now - DatAnfang, "hh:mm:ss"), , "Makro-Laufzeit"
End Sub
Sub Testcasetimeclear()
Range(Cells(2, 3), Cells(Rows.Count, 2)).ClearContents
End Sub
Gruß
Nepumuk