AW: UDF Vorzeichenvergleich, vereinfacht
29.05.2008 10:25:58
Axel
Guten Morgen Renée,
vielen Dank für die vielen Beispiele. Mitlerweile klappt bei mir das nicht mehr, was ich will.
In der letzten Datei 52668 fehlt die Auswahl der zu vergleichenden Zeichenfolgen (Feld E3 in der 52649). Ich weiss nicht, ob das VBA Skript aus der 52668 trotzdem funktioniert und ich nur die Formel umstellen muss.
Ich habe eine Datei mit Daten befüllt und dort steht in der Zelle F4: =SignCompare(B4:B15;Datenbasis!B3:B62545;F3). Wenn ich aus der Zelle gehe, erscheint dort allerdings #NAME?
Ich habe folgendes VBA Skript dort eingefügt:
Public Function SignComparison(rSource As Range, rTarget As Range, iNumber As Integer) As _
String
' Compares a consecutive number (iNumber) of the Signs (+,0,-)
' of an inputrange (rSource) with a targetrange (rTarget)
' Result: cell-range of source(s) and cell-range of target(s)
Application.Volatile
Dim arrSource(), arrSrcPart(), arrTarget()
Dim ixT As Integer, ixS As Integer, ixP As Integer
Dim bDone As Boolean
arrSource = rSource
arrTarget = rTarget
ReDim arrSrcPart(1 To iNumber)
For ixS = 1 To UBound(arrSource, 1) - UBound(arrSrcPart) + 1
For ixP = 1 To UBound(arrSrcPart)
arrSrcPart(ixP) = arrSource(ixS + ixP - 1, 1)
Next ixP
For ixT = 1 To UBound(arrTarget, 1)
bDone = False
For ixP = 1 To UBound(arrSrcPart)
bDone = (Format(arrSrcPart(ixP), """+"";""-"";0") = _
Format(rTarget(ixT + ixP - 1, 1), """+"";""-"";0"))
If Not bDone Then Exit For
Next ixP
If bDone Then _
SignComparison = SignComparison & IIf(Len(SignComparison) = 0, "", Chr(10)) _
& _
ActiveSheet.Cells(rSource.Row + ixS - 1, _
rSource.Column).Address(0, 0) & ":" & _
ActiveSheet.Cells(rSource.Row + ixS + iNumber - 2, _
rSource.Column).Address(0, 0) & _
" = " & rTarget.Worksheet.Name & "!" & _
ActiveSheet.Cells(rTarget.Row + ixT - 1, _
rTarget.Column).Address(0, 0) & ":" & _
ActiveSheet.Cells(rTarget.Row + ixT + iNumber - 2, _
rTarget.Column).Address(0, 0)
Next ixT
Next ixS
If Len(SignComparison) = 0 Then SignComparison = "Keine Übereinstimmung"
End Function
Bitte verzeih mir, wenn ich Dich wieder damit nerve. Ich denke, ich habe da irgendetwas zusammenkopiert, was nicht zusammen gehört.
Kannst Du mir noch ein letztes mal helfen bitte?
Danke schon mal
Axel
