Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1340to1344
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro für Bewertung von String

Makro für Bewertung von String
29.12.2013 10:15:14
String
Hi,
in Spalte A befinden sich 120 Zahlen(4-7stellig) Alle Ziffern unterschiedlich. Für jede Zahl sollen Punkte ermittelt werden: Wenn eine Ziffer der Zahl größer ist als j e d e
andere links von ihr, gibt es einen Punkt. Beispiel: 12345...4 Punkte. 54321...0 Punkte. 41235...1 Punkt. Die Anzahl der Punkte sollen in die nächste Spalte geschrieben werden. Kann jemand helfen?
Gruß, Alifa

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro für Bewertung von String
29.12.2013 10:53:21
String
Hallo Alifa
Versuch mal so:
Tabelle1

 AB
1123454
240802543
398714311
497294522
553310431
623773743
7365683
873953992
965940322
1083066732
1171179393
1232111352
1342288821
1426616983
1547798903
165509572
1737361413
1820624913
1953105492
2052596183
2132049912
2253671973
2327614163
2433108101
253437894

Formeln der Tabelle
ZelleFormel
B1=SUMMENPRODUKT(1*(TEIL(A1;ZEILE(INDIREKT("A1:A"&LÄNGE(A1)-1)); 1)<TEIL(A1;ZEILE(INDIREKT("A2:A"&LÄNGE(A1))); 1)))


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
ransi

Anzeige
AW: Makro für Bewertung von String
29.12.2013 11:20:51
String
Hallo ransi,
alle Ziffern sind unterschiedlich und nur die Ziffern zählen, die größer, als jede andere Ziffer links von ihr ist. Nimmt man aus der Tabelle die Zahl 4080254(die hat zwar 2 Nullen und Vieren), dann entsprechen 1 Punkt, denn nur die 8 ist größer als jede Ziffer links von der 8. Die Formel ermittelt 3.
Vielleicht fällt Dir eine Funktion ein!?
Alifa

AW: Makro für Bewertung von String
29.12.2013 11:35:49
String
Hallo Alifa,
warum nur die 8 ? hab da auch 3 raus
die 8 ist größer als 0
die 2 ist größer als 0
die 5 ist größer als 2
matze

AW: Makro für Bewertung von String
29.12.2013 12:06:50
String
HAllo
Ich glaub jetzt hab ichs verstanden.
So ?
Option Explicit


Public Function machs(lngL As String) As Long
    Dim L As Long
    Dim b() As Byte
    Dim Tmp As Byte
    b = StrConv(lngL, vbFromUnicode)
    For L = UBound(b) To 1 Step -1
        Tmp = b(L)
        Redim Preserve b(L - 1)
        If Tmp > WorksheetFunction.Max(b) Then
            machs = machs + 1
        End If
    Next
End Function


Tabelle1

 AB
1123454
212765432
398714310
497294520
553310430
623773742
7365682
873953991
965940321
1083066730
1171179391
1232111351
1342288821
1426616982
1547798902
165509571

Formeln der Tabelle
ZelleFormel
B1=machs(A1)


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
ransi

Anzeige
AW: Makro für Bewertung von String
29.12.2013 11:09:04
String
Hallo
Als Makro geht z.B. sowas:
Tabelle1

 AB
1123454
298765430
398714311
497294522
553310431
623773743
7365683
873953992
965940322
1083066732
1171179393
1232111352
1342288821
1426616983
1547798903
165509572

Formeln der Tabelle
ZelleFormel
B1=machs(A1)


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit


Public Function machs(lngL As String) As Long
    Dim L As Long
    For L = 1 To Len(lngL) - 1
        If Mid(lngL, L, 1) < Mid(lngL, L + 1, 1) Then
            machs = machs + 1
        End If
    Next
End Function


ransi

Anzeige
und noch eine Variante...
29.12.2013 12:22:02
Erich
Hi Erhard,
so geht's wohl auch: Function maxZiff(strZ As String) As Long Dim pp As Long, qq As Long, strP As String For pp = 2 To Len(strZ) strP = Mid(strZ, pp, 1) For qq = 1 To pp - 1 If Mid(strZ, qq, 1) >= strP Then Exit For Next qq If qq >= pp Then maxZiff = maxZiff + 1 Next pp End Function Da kommt das raus:
 ABCD
11345333
24080254611
31467598644

Formeln der Tabelle
ZelleFormel
B1=SUMMENPRODUKT(1*(TEIL(A1;ZEILE(INDIREKT("A2:A"&LÄNGE(A1))); 1)>MAX(TEIL(A1;ZEILE(INDIREKT("A1:A"&LÄNGE(A1)-1)); 1))))
C1=machs(A1)
D1=maxZiff(A1)

Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
AW: und noch eine Variante...
29.12.2013 14:50:26
Alifa
Hallo,
ja, die beiden Funktionen von Erich und Ransi passen! Wenn die Strings alle Permutationen der 10 Ziffern 0 bis 9 sind, wird es schwierig, sie tabellarisch auszugeben(3628800 Permutationen) Ist es möglich die Summe aller "Punkte"(im Sinne der erstellten Funktionen) dieser Strings mit VBA zu ermitteln?
Gruß, Erhard

mal nur mit Formeln ...
29.12.2013 16:33:00
Matthias
Hallo
oder hab ich was falsch verstanden?
Tabelle2

 ABCDEFGH
1123451234500
24 111100

Formeln der Tabelle
ZelleFormel
B1=--WENNFEHLER(--TEIL($A1;SPALTE()-1;1);0)
C1=--WENNFEHLER(--TEIL($A1;SPALTE()-1;1);0)
D1=--WENNFEHLER(--TEIL($A1;SPALTE()-1;1);0)
E1=--WENNFEHLER(--TEIL($A1;SPALTE()-1;1);0)
F1=--WENNFEHLER(--TEIL($A1;SPALTE()-1;1);0)
G1=--WENNFEHLER(--TEIL($A1;SPALTE()-1;1);0)
H1=--WENNFEHLER(--TEIL($A1;SPALTE()-1;1);0)
A2=SUMME(B2:H2)
C2=WENN(C1>B1;1;0)
D2=WENN(UND(D1>C1;D1>B1);1;0)
E2=WENN(UND(E1>D1;E1>C1;E1>B1);1;0)
F2=WENN(UND(F1>E1;F1>D1;F1>C1;F1>B1);1;0)
G2=WENN(UND(G1>F1;G1>E1;G1>D1;G1>C1;G1>B1);1;0)
H2=WENN(UND(H1>G1;H1>F1;H1>E1;H1>D1;H1>C1;H1>B1);1;0)


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4


Tabelle2

 ABCDEFGH
112135891213589
25 101111


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4


56869605XXXXXX69XXX0
3 110XXX00

Gruß Matthias

Anzeige
AW: mal nur mit Formeln ...
29.12.2013 17:25:49
Matthias
Hallo
Keine Ahnung warum die letzte Tabelle nich korrekt angezeigt wurde
Tabelle2

 ABCDEFGH
156869605686960
23 110100


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
Gruß Matthias

Anzeige
AW: und noch eine Variante...
29.12.2013 17:32:55
Erich
Hi Erhard,
als Punktesumme über alle Permutationen biete ich 6999840.
Ein möglicher Code dafür:

Option Explicit
Dim aPerm(1 To 3628800) As String
Sub aStart()
Dim tt As String, zz As Long, lngSu As Long
tt = "0123456789"
Perm tt, "", 0
For zz = 1 To UBound(aPerm)
lngSu = lngSu + maxZiff(aPerm(zz))
Next zz
MsgBox lngSu
End Sub
Sub Perm(aa$, bb$, Ze&)
Dim ii%, jj%:     jj = Len(aa)
If jj > 1 Then
For ii = 1 To jj
Perm Left(aa, ii - 1) + Right(aa, jj - ii), bb + Mid(aa, ii, 1), Ze
Next ii
Else
Ze = Ze + 1
aPerm(Ze) = bb & aa
End If
End Sub
Function maxZiff(strZ As String) As Long
Dim pp As Long, qq As Long, strP As String
For pp = 2 To Len(strZ)
strP = Mid(strZ, pp, 1)
For qq = 1 To pp - 1
If Mid(strZ, qq, 1) >= strP Then Exit For
Next qq
If qq >= pp Then maxZiff = maxZiff + 1
Next pp
End Function
Rückmeldung ist bei dir eh klar - Grüße aus Kamp-Lintfort von Erich

Anzeige
AW: und noch eine Variante...
29.12.2013 18:17:52
Alifa
Hallo Erich,
ich sehe gerade, die "Permutanten" sind die Zahlen 1-10! nicht, wie ich irrtümlicherweise angenommen habe, 0 bis 9. Falls Dein Code, ohne viel Aufwand, an diese Gegebenheiten angepasst werden kann....
Falls nicht, danke ich für die Funktion. Ich danke für alle Beiträge.
Gruß, Erhard

AW: und noch eine Variante...
29.12.2013 19:12:44
Erich
Hi Erhard,
das wäre ein neuer Code. Der bisherige Code permutiert die einzelnen Zeichen eines Strings der Länge 10.
Würden wir 1 bis 10 statt 0 bis 9 als "Zeichen" verwenden, wäre der String 11 Zeichen lang,
und wir müssten meist eine Ziffer, manchmal aber zwei Ziffern (eben 0 und 1) zusammen als "10" bewegen.
Aber ist es nicht völlig egal, welche Namen/Bezeichnungen/Etiketten die Elemente der permutierten Menge tragen?
Die Anzahl der Permutationen ist davon unabhängig, und die Spezial-Punkte sind es auch.
Wenn du die "1 bis 10"-Permutationen irgendwo brauchst - addiere einfach 1 auf die Zeichen
aller Permutationen von "0 bis 9".
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
AW: und noch eine Variante...
29.12.2013 20:04:32
Alifa
Hallo Erich,
tatsächlich, das stimmt. Dann wäre die Sache in trocknen Tüchern. Ich wünsche Dir und der ganzen Gemeinde
Ein Erfolgreiches Neues Jahr 2014
Erhard

AW: Makro für Bewertung von String
01.01.2014 12:26:03
String
Hallo Alifa,
hier mal eine Matrixformel für die Berechnung (Wert in A1, Eingabe mit Strg+Shift+Enter)
=SUMME((MMULT(((((TEIL(A1;ZEILE(INDIREKT("A1:A"&LÄNGE(A1)));1)>MTRANS(TEIL(A1; ZEILE(INDIREKT("A1:A"&LÄNGE(A1)));1)))*1)+((ZEILE(INDIREKT("A1:A"&LÄNGE(A1)))< =MTRANS(ZEILE(INDIREKT("A1:A"&LÄNGE(A1)))))*1)>=1)*1);1*(ZEILE(INDIREKT("A1:A"&LÄNGE(A1)))>0)) =LÄNGE(A1))*1) -1
Die Formel liefert für jede Permutation den gleichen Wert wie die Funktion von Erich.
Gruß Coach
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige