AW: Wert finden in einem Range Bereich
13.07.2017 10:57:07
Bianca
Danke für die schnelle Antwort.
Es tut mir nur leid das das mir bisher nicht wirklich weiter hilft. Habe jetzt schon ne stunde das internet durchforstet aber wie ich diese funtion einsetzen soll weiß ich jetzt immer noch nicht.
Und was finden genau macht auch nicht. Also findet es da tatsächlich nur werte die 81 sind oder findet es auch werte wie z.B 181 das möchte ich ja nicht.
Public Function KS_Auswertung()
Dim x As String, y As Double, GerNr As String
Dim arrPol1(1 To 200, 1 To 3) As Double
Dim arrPol2(1 To 200, 1 To 3) As Double
Dim arrPol3(1 To 200, 1 To 3) As Double
Dim arrPol4(1 To 200, 1 To 3) As Double
Dim countSchuss As Integer
Dim AnzPole As Integer
Dim AktPol As Integer 'hier soll eingelesen werden _
von welchem Pol gerade die Werte gesucht werden
countSchuss = 0
'~~~~~~Abfrage~GerNr~angegeben~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If UF_KS.TextBox1.Text "" Then
GerNr = UF_KS.TextBox1.Text
x = GerNr
End If
'~~~~~~Anzahl~~~Pole~~~suchen~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Worksheets(1).Select
AnzPole = Left(Cells(16, 2), 1)
Worksheets(2).Select
'~~~~~~Werte-suchen-und-in-Matrix-anlegen~~~~~~~~~
For y = 1 To AnzPole 'geht die Pole L1bisL4 durch
countSchuss = countSchuss + 1
For i = 1 To Sheets(2).UsedRange.Rows.Count
If i = 1 Then
countSchuss = 1
End If 'For i2 = 1 To Sheets(2).UsedRange.Rows. _
Count 'zeile2
If (Sheets(2).Range("B" & i) = x) Then
If (Sheets(2).Range("E" & i) = y) Then
If y = 1 Then
Sheets(2).Range("Q" & i).Select
arrPol1(countSchuss, 1) = Cells(i, "Q")
Selection.Interior.ColorIndex = 39
Sheets(2).Range("U" & i).Select
arrPol1(countSchuss, 2) = Cells(i, "U")
Selection.Interior.ColorIndex = 39
Sheets(2).Range("Z" & i).Select
arrPol1(countSchuss, 3) = Cells(i, "Z")
Selection.Interior.ColorIndex = 39
countSchuss = countSchuss + 1
ElseIf y = 2 Then
Sheets(2).Range("Q" & i).Select
arrPol2(countSchuss, 1) = Cells(i, "Q")
Selection.Interior.ColorIndex = 39
Sheets(2).Range("U" & i).Select
arrPol2(countSchuss, 2) = Cells(i, "U")
Selection.Interior.ColorIndex = 39
Sheets(2).Range("Z" & i).Select
arrPol2(countSchuss, 3) = Cells(i, "Z")
Selection.Interior.ColorIndex = 39
countSchuss = countSchuss + 1
ElseIf y = 3 Then
Sheets(2).Range("Q" & i).Select
arrPol3(countSchuss, 1) = Cells(i, "Q")
Selection.Interior.ColorIndex = 39
Sheets(2).Range("U" & i).Select
arrPol3(countSchuss, 2) = Cells(i, "U")
Selection.Interior.ColorIndex = 39
Sheets(2).Range("Z" & i).Select
arrPol3(countSchuss, 3) = Cells(i, "Z")
Selection.Interior.ColorIndex = 39
countSchuss = countSchuss + 1
ElseIf y = 4 Then
Sheets(2).Range("Q" & i).Select
arrPol4(countSchuss, 1) = Cells(i, "Q")
Selection.Interior.ColorIndex = 39
Sheets(2).Range("U" & i).Select
arrPol4(countSchuss, 2) = Cells(i, "U")
Selection.Interior.ColorIndex = 39
Sheets(2).Range("Z" & i).Select
arrPol4(countSchuss, 3) = Cells(i, "Z")
Selection.Interior.ColorIndex = 39
countSchuss = countSchuss + 1
End If
End If
End If
Next i
Next y
'~~~~~~Maximalwerte-ermitteln~~~~~~~~~~~~~~~~~~~~~~~~
MaxL1_imax = Application.Max(Application.Index(arrPol1, 0, 1))
MaxL2_imax = Application.Max(Application.Index(arrPol2, 0, 1))
MaxL3_imax = Application.Max(Application.Index(arrPol3, 0, 1))
MaxL4_imax = Application.Max(Application.Index(arrPol4, 0, 1))
MaxL1_tk = Application.Max(Application.Index(arrPol1, 0, 2))
MaxL2_tk = Application.Max(Application.Index(arrPol2, 0, 2))
MaxL3_tk = Application.Max(Application.Index(arrPol3, 0, 2))
MaxL4_tk = Application.Max(Application.Index(arrPol4, 0, 2))
MaxL1_Qges = Application.Max(Application.Index(arrPol1, 0, 3))
MaxL2_Qges = Application.Max(Application.Index(arrPol2, 0, 3))
MaxL3_Qges = Application.Max(Application.Index(arrPol3, 0, 3))
MaxL4_Qges = Application.Max(Application.Index(arrPol4, 0, 3))
If UF_KS.TextBox1.Text "" Then
UF_KS.TextBox2.Text = "GerNr: " & "PolNr: " & "max.tk: " & "imax: " & "max.Qges: _
" & Chr(10) _
& " " & " (in ms)" & " (in A) " & " (in kA²s)" & Chr(10) _
& Chr(10) _
& GerNr & " " & Cells(3, 5) & " " & MaxL1_tk & " " & MaxL1_imax & " " & MaxL1_Qges & _
Chr(10) _
& GerNr & " " & Cells(4, 5) & " " & MaxL2_tk & " " & MaxL2_imax & " " & MaxL2_Qges & _
Chr(10) _
& GerNr & "" & Cells(5, 5) & " " & MaxL3_tk & " " & MaxL3_imax & " " & MaxL3_Qges & Chr( _
10) _
& GerNr & " " & Cells(6, 5) & " " & MaxL4_tk & " " & MaxL4_imax & " " & MaxL4_Qges
Else
MsgBox ("Bitte GeräteNumer eintragen")
End If
End Function
VIleicht hilft der ganze Code bei meinem Problem