Wertsuche und Variablenfüllung (Excel VBA 6.5)

Computer: Software & Programmierung Visual Basic
#1

Hallo zusammmen,

es ist ein paar Jahre her das ich mal was mit VBA gemacht hab. Dementsprechend sind auch meine Kenntisse leider sehr eingestaubt.

Ich möchte einen definierten Bereich in einer Tabelle nach einem Wert durchsuchen und bei Übereinstimmung den Wert der direkten rechten Nachbarzelle in eine Variable füllen.

Mein Code sieht wie folgt aus:

Public Function zuordnung()
Dim winuser As String
Dim suche As Range
Dim zielwert As String

winuser = CreateObject(„WScript.Network“).UserName
MsgBox winuser , vbOKOnly, „User“

For Each suche In Range(„A1:A4“)
If suche = winuser Then
zielwert = ActiveCell.Offset(0, 1).Value
MsgBox zielwert , vbOKOnly, „Geschafft“
Exit For
Else: GoTo Weiter
End If
Weiter:
Next suche

End Function

Das ganze funktioniert zwar - aber nicht richtig. Wenn der Treffer in der ersten oder zweiten Zeile ist erscheint auch der richtige Wert in der 2ten MsgBox. Ist der Wert in Zeile 3 oder 4 geht es nicht.

Aber warum? Rein von der Logik her müstte es doch stimmen…

#2

Hallo F.,

Ich möchte einen definierten Bereich in einer Tabelle nach
einem Wert durchsuchen und bei Übereinstimmung den Wert der
direkten rechten Nachbarzelle in eine Variable füllen.

bei größeren Suchbereichen würde ich ggfs.
Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte)
benutzen.

Warum nimmst du Function und nicht Sub?

Der Tag „code“ geht hier nicht, nimm den „pre“ Tag.

Option Explicit

Public Function zuordnung()
Dim winuser As String
Dim suche As Range
Dim zielwert As String
winuser = CreateObject("WScript.Network").UserName
'MsgBox winuser, vbOKOnly, "User"
For Each suche In Range("A1:A4")
 If suche.Value = winuser Then
 zielwert = suche.Offset(0, 1).Value
 MsgBox zielwert, vbOKOnly, "Geschafft"
 Exit For
 End If
Next suche
End Function

Gruß
Reinhard

#3

Hallo F.,

bei größeren Suchbereichen würde ich ggfs.
Find(What, After, LookIn, LookAt, SearchOrder,
SearchDirection, MatchCase, MatchByte)
benutzen.

Insgesammt wird die Suchtabelle 50 Felder haben. Sieht so aus als müsste ich mich mal näher mit den Methoden befassen. Leider hab ich auch keine Bücher mehr…

Warum nimmst du Function und nicht Sub?

Der Tag „code“ geht hier nicht, nimm den „pre“ Tag.

Nun, ich benötige die werte von „winuser“ und „zielwert“ auch an anderen Stellen und eine Function kann ja auch Werte zurückgeben, im Gegensatz zu einer Sub.
Hintergrund ist das diese Excelmappe ein bereits bestehendes, durch Code erweitertes, Tool ist. Ich soll „lediglich“ ein paar Dinge hinzufügen. Zum Beispiel eben auch Dokumente abhängig vom jeweiligen Benutzer geladen werden.
Und weil der Code nicht von mir ist, und zudem auch nicht „nach Lehrbuch“ ist, ist das Ganze etwas abenteuerlich.
Deshalb will ich die Funktionalitäten erstmal so in einer seperaten Mappe erstellen und lauffähig haben bevor ich sie in den eigentlichen Code irgendwie reinwurschtel.

Option Explicit

Public Function zuordnung()
Dim winuser As String
Dim suche As Range
Dim zielwert As String
winuser = CreateObject(„WScript.Network“).UserName
'MsgBox winuser, vbOKOnly, „User“
For Each suche In Range(„A1:A4“)
If suche.Value = winuser Then
zielwert = suche.Offset(0, 1).Value
MsgBox zielwert, vbOKOnly, „Geschafft“
Exit For
End If
Next suche
End Function

Gruß
Reinhard

Vielen danke Reinhard, läuft wie ich es wollte.

#4

Nun, ich benötige die werte von „winuser“ und „zielwert“ auch
an anderen Stellen und eine Function kann ja auch Werte
zurückgeben, im Gegensatz zu einer Sub.

Hallo F.,

dann gib auch Werte zurück. Oder nimm globale Variablen.
Hier zwei Beispiele für beides.
Also entweder das eine oder das andere in ein Standardmodul,
Modul1 o.ä.

Option Explicit

Public winuser As String, zielwert As String

Sub Test()
Call Zuordnung
MsgBox winuser
MsgBox zielwert
End Sub

Sub Zuordnung()
Dim Zelle As Range, Zei As Long
winuser = CreateObject("WScript.Network").UserName
With Worksheets("Tabelle1")
 Zei = .Cells(Rows.Count, "A").End(xlUp).Row
 Set Zelle = .Range("A1:A" & Zei).find(winuser)
End With
zielwert = IIf(Zelle Is Nothing, "Nix", Zelle.Offset(0, 1).Value)
End Sub

\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*

Option Explicit

Sub Test2()
MsgBox fktwinuser
MsgBox fktzielwert
End Sub

Function fktwinuser() As String
fktwinuser = CreateObject("WScript.Network").UserName
End Function

Function fktzielwert() As String
Dim Zelle As Range, Zei As Long
With Worksheets("Tabelle1")
 Zei = .Cells(Rows.Count, "A").End(xlUp).Row
 Set Zelle = .Range("A1:A" & Zei).find(winuser)
End With
fktzielwert = IIf(Zelle Is Nothing, "Nix", Zelle.Offset(0, 1).Value)
End Function

Gruß
Reinhard