Es soll für alle werte die in der Textbox txt_mp stehen den Wert in Spalte A suchen, dann je nachdem welcher Wert in der Combobox ausgewählt wird den Wert aus spalte 4 oder 5 nehmen. Danach soll nach diesem Wert gefiltert werden und alle Zeilen in ein Array geschrieben werden. Das gleich soll für alle folgenden Werte aus txt_mp geschehen. Zum schluss möchte ich das gesammte Array in eine Tabelle schreiben und mittelwerte aus den Daten berechnen. Irgendwie hab ich aber einen bug drin. Ich finde ihn allerdings nicht und würde gerne den inhalt des Arrays als debug.Print anweisung sichtbar machen, denn offensichtlich ist da irgendwo der Käfer drin. Ich habe es allerdings nicht geschaft.
Konkret geht es um diesen Abschnitt:
' Schleife durch die gefilterten Zeilen
Dim row As Range
For Each row In ws.UsedRange.Offset(1, 0).Resize(ws.UsedRange.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Rows
' Gesammelte Werte in die Arrays einfügen (ganze Zeile)
For col = 1 To numCols
Debug.Print ("numCols (Anzahl der Spalten)= " & numCols & " Zellenwerte = " & row.Cells(1, col).value & "col = " & col)
collectedValues(rowIndex, col) = row.Cells(1, col).value
Next col
rowIndex = rowIndex + 1
Debug.Print ("rowIndex = " & rowIndex)
Next row
Next i
der Kontext als das gesamte Sub sieht so aus:
Public Sub FilterAndComputeValues(originalWorkbook As Workbook, cmb_mp As Object, txt_pos As Object, txt_mp As Object)
Dim ws As Worksheet
Set ws = originalWorkbook.Sheets(2)
' Debug: Arbeitsblatt
Debug.Print "Arbeitsblatt: " & ws.Name
' Anzahl der befüllten Zeilen und Spalten ermitteln
Dim numRows As Long
Dim numCols As Long
numRows = ws.Cells(Rows.Count, 1).End(xlUp).row
numCols = ws.Cells(1, Columns.Count).End(xlToLeft).Column
' Debug: Anzahl der Zeilen und Spalten
Debug.Print "Anzahl der Zeilen: " & numRows & "; Anzahl der Spalten: " & numCols
' Einsetzen der spezifischen Werte
ws.Cells(1, 1).value = "Messpunkt"
ws.Cells(1, 2).value = "Layoutvariante"
' Erste Zeile fixieren
ws.Rows("2:2").Select
ActiveWindow.FreezePanes = True
' Filter setzen
ws.Rows("1:1").Select
Selection.AutoFilter
' Extrahieren der Komma separierten Werte
Dim mp_values() As String
mp_values = Split(txt_mp.value, ",")
' Debug: Komma separierte Werte
Debug.Print "Komma separierte Werte: " & Join(mp_values, ", ")
' Arrays zum Speichern der Werte
Dim collectedValues() As Variant
ReDim collectedValues(1 To numRows, 1 To numCols) ' Verwenden Sie numCols für die maximale Größe
Dim rowIndex As Long
rowIndex = 1
' Schleife über die Werte
For i = LBound(mp_values) To UBound(mp_values)
Debug.Print "i= " & i & "; mp_values(i)= " & mp_values(i)
Dim searchRow As Long
On Error Resume Next
searchRow = Application.WorksheetFunction.Match(CLng(Trim(mp_values(i))), ws.Columns("A"), 0)
Debug.Print ("searchrow= " & searchRow)
On Error GoTo 0
If searchRow = 0 Then
MsgBox "Messpunkt " & Trim(mp_values(i)) & " nicht gefunden.", vbCritical
Exit Sub
End If
Dim searchValue As Variant
If cmb_mp.value = "Flat oben oder unten" Then
searchValue = ws.Cells(searchRow, 4).value
ws.Range("1:1").AutoFilter Field:=4, Criteria1:=searchValue
ws.Range("1:1").AutoFilter Field:=2, Criteria1:=CLng(txt_pos.value)
ElseIf cmb_mp.value = "Flat links oder rechts" Then
searchValue = ws.Cells(searchRow, 5).value
ws.Range("1:1").AutoFilter Field:=5, Criteria1:=searchValue
ws.Range("1:1").AutoFilter Field:=2, Criteria1:=CLng(txt_pos.value)
End If
' Schleife durch die gefilterten Zeilen
Dim row As Range
For Each row In ws.UsedRange.Offset(1, 0).Resize(ws.UsedRange.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Rows
' Gesammelte Werte in die Arrays einfügen (ganze Zeile)
For col = 1 To numCols
Debug.Print ("numCols (Anzahl der Spalten)= " & numCols & " Zellenwerte = " & row.Cells(1, col).value & "col = " & col)
collectedValues(rowIndex, col) = row.Cells(1, col).value
Next col
rowIndex = rowIndex + 1
Debug.Print ("rowIndex = " & rowIndex)
Next row
Next i
' Filter entfernen
ws.AutoFilterMode = False
' Erstellen eines neuen Arrays mit der richtigen Anzahl von Zeilen
Dim newCollectedValues() As Variant
ReDim newCollectedValues(1 To rowIndex - 1, 1 To numCols)
' Kopieren Sie die Werte aus dem alten Array in das neue
For i = 1 To rowIndex - 1
For j = 1 To numCols
newCollectedValues(i, j) = collectedValues(i, j)
Next j
Next i
' Weisen Sie das neue Array dem alten Variablennamen zu
collectedValues = newCollectedValues
' Fügen Sie ein neues Arbeitsblatt mit dem Namen "ausgewertete Messdaten" hinzu
Dim newWs As Worksheet
Set newWs = originalWorkbook.Worksheets.Add(After:=originalWorkbook.Worksheets(originalWorkbook.Worksheets.Count))
newWs.Name = "ausgewertete Messdaten"
' Kopieren der ersten Zeile aus Sheet(2)
ws.Rows(1).Copy Destination:=newWs.Rows(1)
' Array in das neue Arbeitsblatt einfügen, beginnend ab Zeile 3
newWs.Range(newWs.Cells(2, 1), newWs.Cells(rowIndex + 1, numCols)).value = collectedValues ' Verwenden Sie numCols
' Mittelwerte der Spalten des Arrays berechnen und in das Arbeitsbuch eintragen
originalWorkbook.Sheets(1).Cells(5, 3).value = Application.WorksheetFunction.Average(ws.Columns(6).SpecialCells(xlCellTypeVisible))
originalWorkbook.Sheets(1).Cells(6, 3).value = Application.WorksheetFunction.Average(ws.Columns(7).SpecialCells(xlCellTypeVisible)) / 1000
originalWorkbook.Sheets(1).Cells(7, 3).value = Application.WorksheetFunction.Average(ws.Columns(8).SpecialCells(xlCellTypeVisible))
originalWorkbook.Sheets(1).Cells(8, 3).value = Application.WorksheetFunction.Average(ws.Columns(9).SpecialCells(xlCellTypeVisible))
originalWorkbook.Sheets(1).Cells(9, 3).value = Application.WorksheetFunction.Average(ws.Columns(10).SpecialCells(xlCellTypeVisible)) / 1000000
originalWorkbook.Sheets(1).Cells(10, 3).value = Application.WorksheetFunction.Average(ws.Columns(11).SpecialCells(xlCellTypeVisible))
originalWorkbook.Sheets(1).Cells(11, 3).value = Application.WorksheetFunction.Average(ws.Columns(12).SpecialCells(xlCellTypeVisible))
originalWorkbook.Sheets(1).Cells(12, 3).value = (Application.WorksheetFunction.Average(ws.Columns(14).SpecialCells(xlCellTypeVisible)) - Application.WorksheetFunction.Average(ws.Columns(13).SpecialCells(xlCellTypeVisible))) / 1000000
Dim cellValue As String
cellValue = ws.Cells(1, 13).value
' Debug: Zellwert
Debug.Print "Zellwert (1, 13): " & cellValue
If Len(cellValue) > 0 Then
originalWorkbook.Sheets(1).Cells(12, 2).value = "Bandbreite@" & Left(cellValue, 4) & " Rx [MHz]"
Else
originalWorkbook.Sheets(1).Cells(12, 2).value = "Bandbreite@----Rx [MHz]" ' Alternativer Text, wenn die Zelle A14 leer ist oder keinen Text enthält
End If
' Debug: Prozedur beendet
Debug.Print "Prozedur FilterAndComputeValues beendet."
End Sub