- #1
B
Billy
Guest
Wie gestern bereits erwähnt hab ich ein kleines Prob mit meiner Funktion welche x mal dieselbe Call aufführt. hier mal der Code
und hier die aufgerufen Funktion
wie ihr villeicht bald merken werdet, habe ich bereits einwenig versucht das Problem mit Boolean bei der wirklich Funktion zu beheben. Ohne erfolg =(
mfg billy
Code:
Option Explicit
Dim v_call As Boolean, alt_x As Boolean
Function Check(Fuehrer_Kurzname, Fuehrer_Name, Spalten_Anfang, Spalten_Ende, _
Zeilen_Anfang, Zeilen_Ende, Fuehrer_Zeile)
Dim ws As Worksheet
Set ws = ActiveSheet
Dim s_fkurz As String, s_fname As String, anfang_spalte As String, ende_spalte As String
Dim anfang_zeile As Long, ende_zeile As Long
s_fkurz = Fuehrer_Kurzname
s_fname = Fuehrer_Name
anfang_spalte = Spalten_Anfang
ende_spalte = Spalten_Ende
anfang_zeile = Zeilen_Anfang
ende_zeile = Zeilen_Ende
If v_call = False Then
Call mark_fuehrer(ws, s_fkurz, s_fname, anfang_spalte, ende_spalte, anfang_zeile, ende_zeile)
v_call = True
End If
Dim l_rows As Long, Bereich As String, l_columns As Long
Bereich = anfang_spalte & anfang_zeile & : & ende_spalte & ende_zeile
l_columns = ws.Range(Bereich).columns.Count - 1
Dim x As Long, y As Long, fuehrer As Long, start As Long, alt_x_x As Long
fuehrer = 0
If alt_x <> False Then
start = alt_x_x
Else
start = 2
End If
For x = start To l_columns
For y = anfang_zeile To ende_zeile
If Cells(y, x) = s_fkurz Then
fuehrer = fuehrer + 1
End If
Next
If fuehrer = 1 And Cells(Fuehrer_Zeile, x).Value <> X Then
Cells(Fuehrer_Zeile, x).Value = X
alt_x = True
alt_x_x = x
End If
alt_x_x wird mit der
If fuehrer <> 1 And Cells(Fuehrer_Zeile, x).Value <> Then
Cells(Fuehrer_Zeile, x).Value =
alt_x = True
alt_x_x = x
End If
fuehrer = 0
Next
If x >= l_columns Then
v_call = False
End If
End Function
und hier die aufgerufen Funktion
Code:
Option Explicit
Dim fmsg_spalte As Long, error_msg As Boolean, fmsg As String, ende As Long
Function mark_fuehrer(ws As Worksheet, s_fkurz, s_fname, anfang_spalte, ende_spalte, _
anfang_zeile, ende_zeile)
Dim Bereich As String, columns As Long
Bereich = anfang_spalte & anfang_zeile & : & ende_spalte & ende_zeile
columns = ws.Range(Bereich).columns.Count - 1
Dim x As Long, y As Long, fuehrer As Long, fuehrer_spalte As String
fuehrer = 0
For x = 2 To columns
For y = anfang_zeile To ende_zeile
If Cells(y, x) = s_fkurz Then
fuehrer = fuehrer + 1
If fuehrer >= 2 Then
fuehrer_spalte = fuehrer_spalte & , & Cells(y, x).Address(rowabsolute:=False, Columnabsolute:=False)
Else
fuehrer_spalte = Cells(y, x).Address(rowabsolute:=False, Columnabsolute:=False)
End If
End If
Next
If fuehrer >= 2 Then
If fmsg_spalte < x And error_msg = False Then
MsgBox (( & fmsg_spalte & ) & x & Der Führer & s_fname & kommt in den Zeilen: & vbLf & fuehrer_spalte & vbLf & vor. Bitte Ändern!)
fmsg_spalte = x
fmsg = fuehrer_spalte
error_msg = True
ElseIf fmsg_spalte = 0 And fmsg = fuehrer_spalte Then
MsgBox (( & fmsg_spalte & ) & x & Der Führer & s_fname & kommt in den Zeilen: & vbLf & fuehrer_spalte & vbLf & vor. Bitte Ändern!)
fmsg_spalte = x
fmsg = fuehrer_spalte
error_msg = True
End If
->MsgBox (fmsg_spalte & <-> & x & |)
End If
->MsgBox (x)
fuehrer = 0
fuehrer_spalte = !
Next
MsgBox (error_msg)
If x > columns Then
error_msg = False
x = columns + 1
ende = ende + 1
MsgBox (ende zum & ende & . mal)
->End
End If
End Function
wie ihr villeicht bald merken werdet, habe ich bereits einwenig versucht das Problem mit Boolean bei der wirklich Funktion zu beheben. Ohne erfolg =(
mfg billy