Supportnet / Forum / Tabellenkalkulation
Makro: Suchfunktion + Zählfunktion
Frage
Hallo Leute,
hab folgendes Makro:
Sub SuchenPersonalnummer_Alter()
´Sucht in Spalte B und springt in Trefferzeile in Spalte Q (=15 Spalten rechts von B)
Dim strFind As String, strSuch As String, menge As String
Do
strFind = InputBox("Bitte Personalnummer eingeben:", Application.UserName, strSuch)
If strFind = "" Then Exit Sub
Columns.Find(What:=strFind, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Offset(0, 15).Activate
Loop Until (strFind = "0")
End Sub
Nun bräuchte ich noch eine Funktion bzw. Erweiterung, die mir automatisch den Wert in der Trefferzeile in Spalte Q erhöht.
Kann mir da jemand weiterhelfen?
Schon mal danke im voraus!
Gruß,
Gennaro
Antwort 1 von Saarbauer
Hallo,
das ganze ist mir nicht verständlich.
Zum einen wird es eine Personalnummer nur einmal geben.
Wenn die Personalnummer in einer andern Liste mehrmals vorkommen kann, da lege eine Variable an die den Wert nach jedem Treffer um 1 erhöht.
Ungetestet
Gruß
Helmut
das ganze ist mir nicht verständlich.
Zum einen wird es eine Personalnummer nur einmal geben.
Wenn die Personalnummer in einer andern Liste mehrmals vorkommen kann, da lege eine Variable an die den Wert nach jedem Treffer um 1 erhöht.
Zitat:
Sub SuchenPersonalnummer_Alter()
´Sucht in Spalte B und springt in Trefferzeile in Spalte Q (=15 Spalten rechts von B)
Dim strFind As String, strSuch As String, menge As String, Treffer as Integer
Treffer = 0
Do
strFind = InputBox("Bitte Personalnummer eingeben:", Application.UserName, strSuch)
If strFind = "" Then Exit Sub
Columns.Find(What:=strFind, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Offset(0, 15).Activate
Treffer 0 Treffer + 1
AktiveCell.Value =Treffer
Loop Until (strFind = "0")
End Sub
Sub SuchenPersonalnummer_Alter()
´Sucht in Spalte B und springt in Trefferzeile in Spalte Q (=15 Spalten rechts von B)
Dim strFind As String, strSuch As String, menge As String, Treffer as Integer
Treffer = 0
Do
strFind = InputBox("Bitte Personalnummer eingeben:", Application.UserName, strSuch)
If strFind = "" Then Exit Sub
Columns.Find(What:=strFind, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Offset(0, 15).Activate
Treffer 0 Treffer + 1
AktiveCell.Value =Treffer
Loop Until (strFind = "0")
End Sub
Ungetestet
Gruß
Helmut
Antwort 2 von Saarbauer
Hallo,
Schreibfehler
richtig
Treffer = Treffer + 1
Gruß
Helmut
Schreibfehler
Zitat:
Treffer 0 Treffer + 1
Treffer 0 Treffer + 1
richtig
Treffer = Treffer + 1
Gruß
Helmut
Antwort 3 von Gennaro
Hallo Helmut,
hab deinen Vorschlag getestet, aber funkts leider nicht.
Zur Erklärung:
Die Schleife habe ich eingebaut, damit die inputbox geöffnet bleibt.
Das Ganze soll für eine Qualitätsprüfung sein, d.h. es soll erfasst werden wieviele Einheiten von einem Mitarbeiter geprüft worden sind.
Gruß,
Gennaro
hab deinen Vorschlag getestet, aber funkts leider nicht.
Zur Erklärung:
Die Schleife habe ich eingebaut, damit die inputbox geöffnet bleibt.
Das Ganze soll für eine Qualitätsprüfung sein, d.h. es soll erfasst werden wieviele Einheiten von einem Mitarbeiter geprüft worden sind.
Gruß,
Gennaro
Antwort 4 von JoeKe
Hi Gennaro,
versuchs mal so:
Sub SuchenPersonalnummer_Alter()
´Sucht in Spalte B und springt in Trefferzeile in Spalte Q (=15 Spalten rechts von B)
Dim strFind As String, strSuch As String, menge As String, Treffer As Integer
Do
strFind = InputBox("Bitte Personalnummer eingeben:", Application.UserName, strSuch)
If strFind = "" Then Exit Sub
Columns.Find(What:=strFind, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Offset(0, 15).Activate
ActiveCell = ActiveCell + 1
Loop Until (strFind = "0")
End Sub
MfG
JöKe
versuchs mal so:
Sub SuchenPersonalnummer_Alter()
´Sucht in Spalte B und springt in Trefferzeile in Spalte Q (=15 Spalten rechts von B)
Dim strFind As String, strSuch As String, menge As String, Treffer As Integer
Do
strFind = InputBox("Bitte Personalnummer eingeben:", Application.UserName, strSuch)
If strFind = "" Then Exit Sub
Columns.Find(What:=strFind, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Offset(0, 15).Activate
ActiveCell = ActiveCell + 1
Loop Until (strFind = "0")
End Sub
MfG
JöKe