Excel VB

[vollmi]

Zuviel Werbung?
-> Hier kostenlos registrieren

Hi Ich habe folgenden Code. der wird in 1000enden Formeln aufgerufen in Excel

Public Function GetAttribute(r As Range) As StringDim AttributSets As Range
Application.Volatile


Set ASet = Worksheets("AttributSets").Range("B2:B100")


GetAttribute = "??"


  For Each al In ASet
    If Not (IsEmpty(Worksheets("AttributSets").Cells(al.Row, 1))) Then
        If (BothemptyOrBothfull(ActiveSheet.Cells(r.Row, r.Column), Worksheets("AttributSets").Cells(al.Row, r.Column - 35))) And _
           (BothemptyOrBothfull(ActiveSheet.Cells(r.Row, r.Column + 1), Worksheets("AttributSets").Cells(al.Row, r.Column - 35 + 1))) And _
           (BothemptyOrBothfull(ActiveSheet.Cells(r.Row, r.Column + 2), Worksheets("AttributSets").Cells(al.Row, r.Column - 35 + 2))) And _
           (BothemptyOrBothfull(ActiveSheet.Cells(r.Row, r.Column + 3), Worksheets("AttributSets").Cells(al.Row, r.Column - 35 + 3))) And _
           (BothemptyOrBothfull(ActiveSheet.Cells(r.Row, r.Column + 4), Worksheets("AttributSets").Cells(al.Row, r.Column - 35 + 4))) And _
           (BothemptyOrBothfull(ActiveSheet.Cells(r.Row, r.Column + 5), Worksheets("AttributSets").Cells(al.Row, r.Column - 35 + 5))) And _
           (BothemptyOrBothfull(ActiveSheet.Cells(r.Row, r.Column + 6), Worksheets("AttributSets").Cells(al.Row, r.Column - 35 + 6))) And _
           (BothemptyOrBothfull(ActiveSheet.Cells(r.Row, r.Column + 7), Worksheets("AttributSets").Cells(al.Row, r.Column - 35 + 7))) And _
           (BothemptyOrBothfull(ActiveSheet.Cells(r.Row, r.Column + 8), Worksheets("AttributSets").Cells(al.Row, r.Column - 35 + 8))) Then
            GetAttribute = Worksheets("AttributSets").Cells(al.Row, 1).Value
            Exit For
        End If


    End If
  Next


End Function


Function BothemptyOrBothfull(c1 As Range, c2 As Range) As Boolean
BothemptyOrBothfull = False
[COLOR=#ff8c00] If (IsEmpty(c1) And IsEmpty(c2)) Or _[/COLOR]
[COLOR=#ff8c00]    (Not (IsEmpty(c1)) And Not (IsEmpty(c2))) Then[/COLOR]
[COLOR=#ff8c00]   BothemptyOrBothfull = True[/COLOR]
[COLOR=#ff8c00] End If[/COLOR]
End Function

Das Orangene ist ja z.B. ein normales XNOR. Leider kennt das Excel nicht, darum das Konstrukt
Aber auch der obere Teil ist ja eigentlich nur ein Wortvergleich als XNOR.
Kann mir jemand einen Tip geben wie ich den Code in ExcelVB schlanker bekomme?

mfG René

 

[hucki]

In einer Excelzelle selbst wäre Anzahl2 verwendbar:

WENN(ANZAHL2(C1:C2)<>1;"gleich";"ungleich")

Das müsste unter VBA CountA entsprechen:

BothemptyOrBothfull = Range(c1, c2).CountA <> 1

Frag mich aber nicht, ab welcher Excel-Version beides vorhanden ist.

 

[hucki]

Zuviel Werbung?
-> Hier kostenlos registrieren

Lt. Google könnte die Syntax unter VBA auch so aussehen müssen:

BothemptyOrBothfull = WorksheetFunction.CountA(ActiveSheet.Range(c1, c2)) <> 1