AW: Spalte suchen - Bereich festlegen - Inhalt zählen
11.07.2017 08:20:57
fcs
Hallo Ronnie,
das kann man etwa wie folgt lösen.
Der Code gehört in das Code-Modul des Userforms,wobei die Function zur Ermittlung der Spalten auch in einem allgemeinen Modul der Datei plaziert werden kann.
Gruß
Franz
Public Function fncSpalte(varWert As Variant, _
Optional bolTextvergleich As Boolean = True, _
Optional bolLetzte As Boolean = False, _
Optional Zeile As Long = 1, _
Optional wks As Worksheet) As Long
'Ermiitelt die Nummer der Spalte mit dem Wert in der Zeile des Tabelenblatts
'Wird der Wert nicht gefunden wird als Ergebnis 0 zurückgegeben
'varWert = Wert nach dem gesucht werden soll
'bolTextvergleich = True --> angezeigter Text der Zelle wird verglichen _
= False --> Wert in der Zelle wird verglichen _
kann relevant sein für Zellen mit Zahl, Datum oder boolschem Inhalt
'bolLetzte = True --> Letzte Spalte mit dem Wert wird als Ergebnis zurückgegeben _
= False --> 1. Spalte mit dem Wert wird als Ergebnis zurückgegeben
'Zeile = Nummer der Zeile in der gesucht werden soll - Vorgabewert = 1
'wks = Tabellenblatt in dem gesucht werden soll - Vorgabe = aktivesTabellenblatt
Dim Spalte As Long
If wks Is Nothing Then Set wks = ActiveSheet 'Tabellenblatt in dem gezählt weden soll
fncSpalte = 0
With wks
For Spalte = 1 To .Cells(Zeile, .Columns.Count).End(xlToLeft).Column
If varWert = IIf(bolTextvergleich, .Cells(Zeile, Spalte).Text, _
.Cells(Zeile, Spalte).Value) Then
fncSpalte = Spalte
If bolLetzte = False Then Exit For
End If
Next
End With
End Function
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim Spalte As Long
With Me.TextBox1
Spalte = fncSpalte(.Value, wks:=ActiveSheet)
If Spalte > 0 Then
'Spalte in Tag-Eigenschaft merken
.Tag = Spalte
Call prcZaehlen
Else
.Tag = ""
MsgBox "Eingabewert nicht gefunden"
Cancel = True
End If
End With
End Sub
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim Spalte
With Me.TextBox2
Spalte = fncSpalte(.Value, wks:=ActiveSheet)
If Spalte > 0 Then
.Tag = Spalte
Call prcZaehlen
Else
.Tag = ""
MsgBox "Eingabewert nicht gefunden"
Cancel = True
End If
End With
End Sub
Private Sub prcZaehlen()
Dim Spa_1 As Long, Spa_2 As Long
Dim Zei_1 As Long, Zei_2 As Long
Dim wks As Worksheet
If Val(Me.TextBox2.Tag) > 0 And Val(Me.TextBox1.Tag) > 0 Then
'Spalten aus Tag-Eigenschaft der Boxen auslesen
Spa_1 = Val(Me.TextBox1.Tag)
Spa_2 = Val(Me.TextBox2.Tag)
Set wks = ActiveSheet 'Tabellenblatt in dem gezählt werden soll
With wks
Zei_1 = 3
Zei_2 = .UsedRange.Row + .UsedRange.Rows.Count - 1
'oder fester Wert
'Zei_2=50
If Zei_2