AW: Zellen abhängig kopieren/berechnen
26.07.2022 13:13:34
Gunnar
Hat sich erledigt... war doch einfacher als gedacht :)
Lösung wäre (wenn auch recht lang laufend):
(und ja: Ich habe mich schamlos hier und in anderen Foren "bedient" :) danke an alle, die Ihren Code gepostet hatten)
Sub ImportKPI()
Dim sFile As String
Dim lngLetzte As Long
Dim lngQuelle As Long
Dim lngStartLetzte As Long
Dim lngStart As Long
Dim cntOutlier As Long
Dim sumAVG As Long
Dim cntAVG As Long
Range("A:L").ClearContents
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.InitialFileName = ActiveWorkbook.Path & "\"
If .Show = -1 Then
sFile = .SelectedItems(1)
Else
'Abbrechen falls keine Datei ausgewählt
MsgBox "Keine Daten zum Import ausgewählt!", , "Abbruch"
Exit Sub
End If
End With
If sFile "" Then
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & sFile, Destination:=Range("A1"))
.Name = "Importdatei"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 1, 2, 2, 2, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End If
Columns("B:B").Select
Selection.NumberFormat = "d/m/yy h:mm;@"
'Zahlen auch als Zahlen darstellen:
With Worksheets("Tabelle1").Columns("C")
.NumberFormat = "General"
.Value = .Value
End With
With Worksheets("Report")
' letzte benutzte Zeile in Spalte B
lngStartLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 2)), .Cells(.Rows.Count, 2).End(xlUp).Row, .Rows.Count)
For lngStart = 2 To lngStartLetzte
cntOutlier = 0
sumAVG = 0
cntAVG = 0
With Worksheets("Tabelle1")
' letzte benutzte Zeile in Spalte I
lngLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 6)), .Cells(.Rows.Count, 6).End(xlUp).Row, .Rows.Count)
' Schleife über alle Zeilen von 1 bis zur letzten ermittelten Zeile
For lngQuelle = 1 To lngLetzte
' laufende Zelle in F ist nicht leer
If .Cells(lngQuelle, 6) = Worksheets("Report").Cells(lngStart, 2) And .Cells(lngQuelle, 5) = "min" Then
'kopieren nach Report Zielzelle
.Cells(lngQuelle, 3).Copy Worksheets("Report").Cells(lngStart, 3)
'und den treshold direkt noch mit:
.Cells(lngQuelle, 4).Copy Worksheets("Report").Cells(lngStart, 6)
End If
If .Cells(lngQuelle, 6) = Worksheets("Report").Cells(lngStart, 2) And .Cells(lngQuelle, 5) = "max" Then
'kopieren nach Report Zielzelle
.Cells(lngQuelle, 3).Copy Worksheets("Report").Cells(lngStart, 4)
End If
If .Cells(lngQuelle, 6) = Worksheets("Report").Cells(lngStart, 2) And .Cells(lngQuelle, 5) = "CountAll" Then
'kopieren nach Report Zielzelle
.Cells(lngQuelle, 3).Copy Worksheets("Report").Cells(lngStart, 7)
End If
If .Cells(lngQuelle, 6) = Worksheets("Report").Cells(lngStart, 2) And .Cells(lngQuelle, 5) = "outlier" Then
'outlier hochzaehlen
cntOutlier = cntOutlier + 1
End If
If .Cells(lngQuelle, 6) = Worksheets("Report").Cells(lngStart, 2) And .Cells(lngQuelle, 5).Value Like "AVGDAY_*" Then
'outlier hochzaehlen
If .Cells(lngQuelle, 3).Value "NaN" Then
cntAVG = cntAVG + 1
sumAVG = sumAVG + .Cells(lngQuelle, 3).Value
End If
End If
Next lngQuelle
Worksheets("Report").Cells(lngStart, 8) = cntOutlier
If sumAVG 0 Then
Worksheets("Report").Cells(lngStart, 5) = sumAVG / cntAVG
Else
Worksheets("Report").Cells(lngStart, 5) = "NaN"
End If
End With
Next lngStart
'Zahlen auch als Zahlen darstellen:
With Worksheets("Report").UsedRange
.NumberFormat = "General"
.Value = .Value
End With
End With
End Sub