Inzwischen ist mir eingefallen,...
13.08.2007 04:28:48
Luc:-?
...Ramses,
dass ich zu einem ähnlichen Problem hier schon mal was gepostet hatte. Allerdings war das mit der Erweiterung von VERKETTEN damals nur eine aus der Aufgabe entstandene Idee, die ich zwischenzeitlich verwirklicht hatte. Da es sich hierbei aber nicht um eine udF handelt, war es noch nicht in meine reguläre Sammlung eingegangen. Aber ich habe es mal rausgesucht. Es wdn eine Eventproc im jeweiligen TabBlatt und eine Subroutine in einem Standardmodul benötigt:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count = 1 Then
If Target.HasArray And InStr(Target.Formula, "CONCATENATE(") > 0 Then
Call Concate(Target)
End If
End If
End Sub
Sub Concate(ByRef FZelle As Range)
Dim fma As Integer, klo As Integer, kls As Integer, klt As Integer, _
x As Range, Ber As Variant, y As Variant, z As Variant, TrZ As Variant, _
far As String, fml As String, fop As String, sar As String, tzx As Boolean
On Error Resume Next
Application.EnableEvents = False
fma = InStr(FZelle.Formula, "CONCATENATE(")
kls = InStr(fma + 12, FZelle.Formula, ")")
klo = InStr(fma + 12, Left(FZelle.Formula, kls), "(")
klt = InStr(fma + 12, Left(FZelle.Formula, IIf(klo = 0, kls, klo)), ",")
tzx = (klt > 0)
Do While klo > 0 'And klo 0 And klt "" Then TrZ = Evaluate("=" & fop) Else TrZ = ""
If Not IsArray(TrZ) Then
If IsArray(Ber) Then
Set x = Range(far)
If x Is Nothing Then
For Each z In Ber
If FZelle.NumberFormat = "General" Then
z = Format(z, "General Number")
Else: z = Format(z, FZelle.NumberFormat)
End If
y = IIf(IsEmpty(y), z, y & TrZ & z)
Next z
GoTo fz
End If
va: If Range(far).Count = 1 Then GoTo ex
For Each x In Range(far)
If x.NumberFormat = "General" Then
z = Format(x.Value, "General Number")
Else: z = Format(x.Value, x.NumberFormat)
End If
y = IIf(IsEmpty(y), z, y & TrZ & z)
Next x
GoTo fz
ElseIf InStr(far, "{") And InStr(far, "}") Then
sar = Mid(far, InStr(far, "{"), InStr(far, "}") - InStr(far, "{") + 1)
For Each z In Evaluate(sar)
y = IIf(IsEmpty(y), "", y & TrZ) & Evaluate(Replace(far, sar, z))
Next z
fz: With FZelle
.Formula = Replace(.Formula, fml, """" & y & """")
End With
End If
End If
ex: Set FZelle = Nothing: Set x = Nothing
Application.EnableEvents = True
End Sub
Die Formel muss als Matrixformel angegeben wdn und bleibt nur teilweise erhalten. VERKETTEN und alle Fktt innerhalb davon wdn durch das Ergebnis ersetzt.
Ergebnis: 5,8,3,2
ursprüngliche Formel: {=wechseln(wechseln(verketten(wenn(A1:H1="";"#";A1:H1);",");"#,";"");",#";"")}
verbleibende Formel: =WECHSELN(WECHSELN("#,5,#,8,3,#,2,#";"#,";"");",#";"")
Da ich danach strebe, möglichst wenige Insellösungen, sondern eher universelle zu produzieren, ist die von dir hinterfragte udF und leider auch ihre Erweiterung ListOn durch den Einsatz einer Universal-udF "verseucht", die mehrere Seiten Code umfasst. Das muss ich unbedingt noch mal ändern.
Gruß Luc :-?