Formel zählenwenn

Hallo zusammen,
ich benötige nochmals die Hilfe von Formelexperten.
In der Spalte N ab Zeile 5 bis "unendlich" befinden sich die Buchstaben "s, S, u, U, n und N". Jetzt möchte ich, wenn ich einen Bereich aus dieser Spalte N mit der Maus auswähle, dass die Anzahl der vorhanden Buchstaben angezeigt werden.
Beispiel ist wohl einfacher (hier der ausgewählte Bereich):
s
U
n
S
U
s
Anzeige:
a 3 - A 3 - a/A 6
s 2 - S 1 - s/S 3
u 0 - U 2 - u/U 2
n 1 - N 0 - n/N 1
A ist die jeweilige Summe von s,u,n bzw. S,U,N bzw. s/S, u/U, n/n
Die Anzeige wäre in Spalten P bis S (Zeile 1 bis 4) optimal. Wird kein Bereich ausgewählt, so soll das Ergebnis der gesamten Spalte N angezeigt werden (also nicht nur ein Ausschnitt, sondern alles).
Kann mich hier jemand tatkräftig unterstützen?
Vielen Dank!
Viele Grüße
Markus

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

' ********************************************************************** ' Modul: Tabelle2 Typ: Element der Mappe(Sheet, Workbook, ...) ' ********************************************************************** Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim Arr As Variant Dim Bereich Dim Mydic Dim zelle As Range Set Bereich = Intersect(Target, Range("N:N")) If Bereich Is Nothing Then Exit Sub Set Mydic = CreateObject("Scripting.Dictionary") With Mydic .comparemode = 0 .Add "a", 0 .Add "s", 0 .Add "u", 0 .Add "n", 0 .Add "A", 0 .Add "S", 0 .Add "U", 0 .Add "N", 0 End With For Each zelle In Bereich If Mydic.exists(zelle.Value) Then Mydic(zelle.Value) = Mydic(zelle.Value) + 1 Next Range("P1").Resize(Mydic.Count) = WorksheetFunction.Transpose(Mydic.keys) Range("Q1").Resize(Mydic.Count) = WorksheetFunction.Transpose(Mydic.items) End Sub

HAllo
Vergiss den letzten Post.
Entsprach nicht ganz den Bedingungen.
Versuch ma diesen:

' **********************************************************************
' Modul: Tabelle2  Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Arr As Variant
    Dim Bereich
    Dim Mydic1
    Dim Mydic2
    Dim zelle As Range
    Set Bereich = Intersect(Target, Range("N:N"))
    If Bereich Is Nothing Then Exit Sub
    Set Mydic1 = CreateObject("Scripting.Dictionary")
    Set Mydic2 = CreateObject("Scripting.Dictionary")
    With Mydic1
        .comparemode = 0
        .Add "a", 0
        .Add "s", 0
        .Add "u", 0
        .Add "n", 0
    End With
    With Mydic2
        .comparemode = 0
        .Add "A", 0
        .Add "S", 0
        .Add "U", 0
        .Add "N", 0
    End With
    For Each zelle In Bereich
        If Mydic1.exists(zelle.Value) Then
            Mydic1(zelle.Value) = Mydic1(zelle.Value) + 1
            Mydic1("a") = Mydic1("a") + 1
        End If
        If Mydic2.exists(zelle.Value) Then
            Mydic2(zelle.Value) = Mydic2(zelle.Value) + 1
            Mydic2("A") = Mydic2("A") + 1
        End If
    Next
    Range("P1").Resize(Mydic1.Count) = WorksheetFunction.Transpose(Mydic1.keys)
    Range("Q1").Resize(Mydic1.Count) = WorksheetFunction.Transpose(Mydic1.items)
    Range("R1").Resize(Mydic2.Count) = WorksheetFunction.Transpose(Mydic2.keys)
    Range("S1").Resize(Mydic2.Count) = WorksheetFunction.Transpose(Mydic2.items)
End Sub

ransi

Beliebteste Forumthreads (12 Monate)

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread