Anzeige
Archiv - Navigation
1504to1508
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

Größten Wert merken und ausgeben | Herbers Excel-Forum"

Größten Wert merken und ausgeben
24.07.2016 19:54:29
ViGo

Hallo zusammen!
Ich habe folgendes Problem.
Ich habe in Spalte A Kriterien, die ich in Spalte B gewichtet hab.
Diese Kriterien sind dann mit ja=2, jein=1 und nein= 0 bewertet worden.
Ich berechne nun den Nutzwert pro Zeile. Das klappt soweit auch alles.

Option Explicit
Sub Zwei_Größten_Werte_ausgeben()
Dim a, b, c, d, i, aa As Long
Dim letztezeile As Variant
With Worksheets(1)
letztezeile = Worksheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
For i = 9 To letztezeile
If .Cells(i, 1) = "ja" Then
a = 2
ElseIf .Cells(i, 1) = "jein" Then
a = 1
Else
a = 0
End If
If .Cells(i, 2) = "ja" Then
b = 2
ElseIf .Cells(i, 2) = "jein" Then
b = 1
Else
b = 0
End If
If .Cells(i, 3) = "ja" Then
c = 2
ElseIf .Cells(i, 3) = "jein" Then
c = 1
Else
c = 0
End If
If .Cells(i, 4) = "ja" Then
d = 2
ElseIf .Cells(i, 4) = "jein" Then
d = 1
Else
d = 0
End If
aa = a * .Cells(2, 2) + b * .Cells(3, 2) + c * .Cells(4, 2) + d * .Cells(5, 2)
.Cells(i, 5) = aa
Next i
End With
End Sub

Wie kriege ich es hin, dass mir nun der größte und der zweitgrößte Nutzwert ausgegeben wird???
Ich hab euch mal eine Beispielmappe angehängt mit anonymisierten Daten.
https://www.herber.de/bbs/user/107211.xlsx
Ich habe in Wirklichkeit viel mehr Kriterien und viel mehr Zeilen...
Habt ihr eine Idee wie ich das beschriebene Problem lösen kann???
Viele Grüße,
ViGo

18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Größten Wert merken und ausgeben
24.07.2016 20:51:56
Werner
Hallo,
wie und wo ausgeben?
Per VBA in einer MessageBox?
g = Application.WorksheetFunction.Large(Range("B2:B5), 1)
MsgBox "Größter Nutzwert ist " & g
z = Application.WorksheetFunction.Large(Range("B2:B5"), 2)
MsgBox "Zweitgrößter Nutzwert ist " & z
Per Formel in einer Zelle?
=KGRÖSSTE(B2:B5;1)
=KGRÖSSTE(B2:B5;2
Gruß Werner
AW: Größten Wert merken und ausgeben
24.07.2016 21:08:19
ViGo
Hallo Werner!
Tut mir leid, ich hatte die falsche Datei hochgeladen.
https://www.herber.de/bbs/user/107213.xlsx
Also es sollen die beiden größten berechneten Nutzwerte (werden im Code berechnet) in Zelle H3, H4 mit VBA ausgegeben werden.
Ich lasse die Nutzwerte pro Zeile per VBA berechnen und schreib sie nirgends in eine Zelle. Mich interessieren lediglich die zwei Größten (in der echten Datei die 5 größten Werte).
Also muss der Code sich immer die zwei Größten merken und überschreiben... Oder irgendwie so...
Hat da vielleicht jemand eine Idee wie man sowas umsetzt?
Viele Grüße, ViGo
Anzeige
AW: Größten Wert merken und ausgeben
24.07.2016 21:24:26
Werner
Hallo,
ich würde die berechneten Werte pro Schleifendurchlauf jeweils in eine freie, ausgeblendete Spalte der jeweiligen Zeile schreiben lassen und dann die Werte mit KGrösste holen.
Gruß Werner
AW: Größten Wert merken und ausgeben
25.07.2016 19:15:01
ViGo
Ok, dann werd ich das so probieren. Kann man mit der Formel auch den zweitgrößten, drittgrößten, viertgrößten und fünftgrößten Wert holen???
Ich hab nun versucht die jeweiligen Nutzwerte in diese ausgeblendete Zele zu schreiben... Aber irgendwie ist mein Code falsch. Es wird gesagt, dass ein "else ohne if" vorliegt! Und ich seh es einfach nicht! Wisst ihr auf die schnelle wo da was zu viel sein soll?
Sub Abgleich_Marktanalyse()
Dim i As Long
Dim letztezeile As Long
Dim eingabe As Variant
Dim a As Variant
Dim b As Variant
Dim c As Variant
Dim d As Variant
Dim e As Variant
Dim f As Variant
Dim g As Variant
Dim h As Variant
letztezeile = Worksheets("Marktanalyse").UsedRange.SpecialCells(xlCellTypeLastCell).Row
eingabe = Worksheets("Auswahl_Parametereingabe_1")
With Worksheets("Marktanalyse")
For i = 3 To letztezeile
' MUSS-Parameter-Abfrage
If _
.Cells(i, 5) = eingabe.Cells(16, 5) And _
.Cells(i, 6) = eingabe.Cells(17, 5) And _
.Cells(i, 7) = eingabe.Cells(18, 5) And _
.Cells(i, 8) = eingabe.Cells(19, 5) And _
.Cells(i, 9) = eingabe.Cells(20, 5) And _
.Cells(i, 10) = eingabe.Cells(21, 5) And _
.Cells(i, 11) = eingabe.Cells(22, 5) And _
.Cells(i, 12) = eingabe.Cells(23, 5) Then
'KANN-Paramter
If .Cells(i, 13) = "erfüllt" Or .Cells(i, 13) = "sehr hoch" Then a = 2
ElseIf .Cells(i, 13) = "indifferent" Or .Cells(i, 13) = "hoch" Then a = 1
ElseIf .Cells(i, 13) = "nicht erfüllt" Or .Cells(i, 13) = "mittel" Then a = 0
End If
If .Cells(i, 14) = "erfüllt" Or .Cells(i, 14) = "sehr hoch" Then b = 2
ElseIf .Cells(i, 14) = "indifferent" Or .Cells(i, 14) = "hoch" Then b = 1
ElseIf .Cells(i, 14) = "nicht erfüllt" Or .Cells(i, 14) = "mittel" Then b = 0
End If
If .Cells(i, 15) = "erfüllt" Or .Cells(i, 15) = "sehr hoch" Then a = 2
ElseIf .Cells(i, 15) = "indifferent" Or .Cells(i, 13) = "hoch" Then a = 1
ElseIf .Cells(i, 15) = "nicht erfüllt" Or .Cells(i, 13) = "mittel" Then a = 0
End If
If .Cells(i, 16) = "erfüllt" Or .Cells(i, 16) = "sehr hoch" Then a = 2
ElseIf .Cells(i, 16) = "indifferent" Or .Cells(i, 16) = "hoch" Then a = 1
ElseIf .Cells(i, 16) = "nicht erfüllt" Or .Cells(i, 16) = "mittel" Then a = 0
End If
If .Cells(i, 17) = "erfüllt" Or .Cells(i, 17) = "sehr hoch" Then a = 2
ElseIf .Cells(i, 17) = "indifferent" Or .Cells(i, 17) = "hoch" Then a = 1
ElseIf .Cells(i, 17) = "nicht erfüllt" Or .Cells(i, 17) = "mittel" Then a = 0
End If
If .Cells(i, 18) = "erfüllt" Or .Cells(i, 18) = "sehr hoch" Then a = 2
ElseIf .Cells(i, 18) = "indifferent" Or .Cells(i, 18) = "hoch" Then a = 1
ElseIf .Cells(i, 18) = "nicht erfüllt" Or .Cells(i, 18) = "mittel" Then a = 0
End If
If .Cells(i, 19) = "erfüllt" Or .Cells(i, 19) = "sehr hoch" Then a = 2
ElseIf .Cells(i, 19) = "indifferent" Or .Cells(i, 19) = "hoch" Then a = 1
ElseIf .Cells(i, 19) = "nicht erfüllt" Or .Cells(i, 19) = "mittel" Then a = 0
End If
If .Cells(i, 20) = "erfüllt" Or .Cells(i, 20) = "sehr hoch" Then a = 2
ElseIf .Cells(i, 20) = "indifferent" Or .Cells(i, 20) = "hoch" Then a = 1
ElseIf .Cells(i, 20) = "nicht erfüllt" Or .Cells(i, 20) = "mittel" Then a = 0
End If
Cells(i, 29) = (a * eingabe.Cells(26, 5) + b * eingabe.Cells(27, 5) + c * eingabe.Cells(28, 5) + _
d * eingabe.Cells(29, 5) + e * eingabe.Cells(30, 5) + f * eingabe.Cells(31, 5) + g * eingabe.Cells(32, 5) + h * eingabe.Cells(32, 5)) / _
(2 * eingabe.Cells(26, 5) + 2 * eingabe.Cells(27, 5) + 2 * eingabe.Cells(28, 5)  _
+ 2 * eingabe.Cells(29, 5) + 2 * eingabe.Cells(30, 5) + 2 * eingabe.Cells(31, 5) + 2 * eingabe.Cells(32, 5) + 2 * eingabe.Cells(32, 5))
Else: End If
Next i
End With
End Sub
Vielen Dank für eure Hilfe!
Gruß, ViGo
Anzeige
AW: Größten Wert merken und ausgeben
25.07.2016 20:14:28
Werner
Hallo,
das kannst du so nicht schreiben:
If .Cells(i, 13) = "erfüllt" Or .Cells(i, 13) = "sehr hoch" Then a = 2
ElseIf .Cells(i, 13) = "indifferent" Or .Cells(i, 13) = "hoch" Then a = 1
ElseIf .Cells(i, 13) = "nicht erfüllt" Or .Cells(i, 13) = "mittel" Then a = 0
End If
Dadurch, dass du nach dem Then in der gleichen Zeiel noch eine Anweisung hast, ist die If-Anweisung abgeschlossen (ohne End If) und deshalb meckert er ElseIf ohne If.
Wenn, dann musst du das jeweils so schreiben:
If .Cells(i, 13) = "erfüllt" Or .Cells(i, 13) = "sehr hoch" Then
a = 2
ElseIf .Cells(i, 13) = "indifferent" Or .Cells(i, 13) = "hoch" Then
a = 1
ElseIf .Cells(i, 13) = "nicht erfüllt" Or .Cells(i, 13) = "mittel" Then
a = 0
End If
=KGRÖSSTE(B2:B5;1) größter Wert
=KGRÖSSTE(B2:B5;2) zweitgrößter Wert
uss.
Gruß Werner
Anzeige
AW: Größten Wert merken und ausgeben
26.07.2016 11:29:42
ViGo
Ja, du hast Recht, Werner. Das war der Fehler! Nun bekomm ich keine Fehlermeldung mehr. Danke dir! Ich werde versuchen in Zukunft darauf zu achten!
Nun hat dich noch ein weiteres Problem ergeben:
Ich möchte ja einen Wert berechnen. Dafür schau ich mir zunächst an, welches Wort in einer Zelle steht und ordne diesem Wort einen Wert zu. Ich möchte alle Werte betrachten, die in der Zelle bspw. "erfüllt" stehen haben. Es gibt dabei Zellen, da steht nur "erfüllt" drinnen, in anderen steht "erfüllt;indifferent". Ich möchte das beide betrachtet werden...
Ich hab etwas gegoogled und bin hier drauf gestoßen:
If .Cells(i, 14) Like "*erfüllt*" Or .Cells(i, 14) Like "*sehr hoch*" Then
b = 2
...
Allerdings wird mir nur der Wert berechnet, wenn "erfüllt" in der Zelle steht. Der Code übergeht Zellen mit "erfüllt;indifferent". Hat jemand eine Idee wie ich den Code abändern muss, dass er auch beide Inhalte betrachtet?#
Zur Info: Es gibt Zellen, da steht "erfüllt" drinnen, aber auch Zellen da steht "erfüllt;indifferent" oder "indifferent;erfüllt" drinnen... Ich weiß nicht, ob das wichtig ist... Ich hab ja eigentlich gedacht, dass ich das durch like "*xxx*" abgefangen hätte.... Scheinbar doch nicht
Viele Grüße,
ViGo
Anzeige
AW: Größten Wert merken und ausgeben
26.07.2016 12:54:29
Werner
Hallo,
der Code an sich stimmt so und liefert auch das richtige Ergebnis. Versuch mal den Code hier auf einem neuen Tabellenblatt, angesprochen wird die Zelle A1.
Public Sub test()
With Sheets("Tabelle1")
If .Cells(1, 1) Like "*erfüllt*" Or .Cells(1, 1) Like "*sehr hoch*" Then
MsgBox "Hurra"
End If
End With
End Sub
Bist du sicher, dass du auf dem richtigen Blatt suchst, aktuell prüfst du das Blatt "Marktanalyse".
Gruß Werner
AW: Größten Wert merken und ausgeben
26.07.2016 13:21:37
ViGo
Ja, ich suche auf dem Blatt "Marktanalyse". Ich bekommen den Wert auch berechnet und ausgegeben, wenn in der Zelle "erfüllt" steht (soweit alles richtig!). Er wird allerdings nicht berechnet für "erfüllt;indifferent" oder "indifferent;erfüllt"...
Das ist wirklich seltsam... Gibt es irgendwelche Bedingungen, die für den Operator like erfüllt sein müssen??? Ich hab schon geguckt und nichts gefunden...
Ich hab deinen Code auf einem neuen Arbeitsblatt ausgeführt, da funktioniert er. Die Excel-Mappe ist nicht kaputt...
Anzeige
AW: Größten Wert merken und ausgeben
26.07.2016 13:25:34
Werner
Hallo,
das ist so schwierig bis gar nicht zu sagen. Kannst du mal eine Beispielmappe mit ein paar Daten hochladen, bei der es nicht funktioniert?
Kann aber erst in zwei Tagen wieder etwas dowloaden.
Gruß Werner
AW: Größten Wert merken und ausgeben
26.07.2016 17:07:19
ViGo
Entschuldige, dass es so lange gedauert hat. Ich hab eine Beispiel-Datei hochgeladen.
https://www.herber.de/bbs/user/107253.xlsx
Hier der Code dazu...
Option Explicit
Sub Zwei_Größten_Werte_ausgeben()
Dim a, b, c, d, i, aa As Long
Dim letztezeile As Variant
With Worksheets(1)
letztezeile = Worksheets("Tabelle1").UsedRange.SpecialCells(xlCellTypeLastCell).Row
For i = 9 To letztezeile
If Worksheets("Tabelle2").Cells(2, 1).Value Like .Cells(i, 1).Value And _
Worksheets("Tabelle2").Cells(2, 2).Value Like .Cells(i, 2).Value And _
Worksheets("Tabelle2").Cells(2, 3).Value Like .Cells(i, 3).Value And _
Worksheets("Tabelle2").Cells(2, 4).Value Like .Cells(i, 4).Value Then _
If .Cells(i, 1) Like "*ja*" Then
a = 2
ElseIf .Cells(i, 1) Like "*jein*" Then
a = 1
Else
a = 0
End If
If .Cells(i, 2) Like "*ja*" Then
b = 2
ElseIf .Cells(i, 2) Like "*jein*" Then
b = 1
Else
b = 0
End If
If .Cells(i, 3) Like "*ja*" Then
c = 2
ElseIf .Cells(i, 3) Like "*jein*" Then
c = 1
Else
c = 0
End If
If .Cells(i, 4) Like "*ja*" Then
d = 2
ElseIf .Cells(i, 4) Like "*jein*" Then
d = 1
Else
d = 0
End If
aa = a * .Cells(2, 2) + b * .Cells(3, 2) + c * .Cells(4, 2) + d * .Cells(5, 2)
.Cells(i, 5) = aa
End If
Next i
End With
End Sub

Es ist dasselbe Problem... In Tabelle2 stehen die gesuchten Wörter. In Zeile 9 müsste eigentlich auch ein Wert berechnet werden, aber das passiert nicht...
Hab ich da vielleicht die Funktion des Operators like nicht verstanden??? Muss ich da anders herangehen? Ich bin über jede Idee dankbar!
Viele Grüße, ViGo
Anzeige
AW: Größten Wert merken und ausgeben
27.07.2016 07:23:34
Werner
Hallo,
da ist was unklar bzw. stimmt nicht.
Was möchtest du hier mit was vergleichen?
If Worksheets("Tabelle2").Cells(2, 1).Value Like .Cells(i, 1).Value And _
Worksheets("Tabelle2").Cells(2, 2).Value Like .Cells(i, 2).Value And _
Worksheets("Tabelle2").Cells(2, 3).Value Like .Cells(i, 3).Value And _
Worksheets("Tabelle2").Cells(2, 4).Value Like .Cells(i, 4).Value Then _
Ich gehe mal davon aus, dass du Blatt2 A2 mit Blatt1 A9, Blatt2 B2 mit Blatt1 B9, Blatt2 C2 mit Blatt1 C9 und Blatt2 D2 mit Blatt1 D9 vergleichen willst.
Du vergleichst aber die zweite Zeile aus Blatt2 mit der ersten Spalte in Blatt1.
Sprich A2 mit A9, B2 mit A10, C2 mit A11 und D2 mit A12
Gruß Werner
Anzeige
AW: Größten Wert merken und ausgeben
28.07.2016 02:24:47
Werner
Hallo,
kein Interesse mehr? Auf meine letzte Nachricht hast du dich nicht mehr gemeldet.
Für dein hochgeladenes Beispiel mal ein Code so wie ich mir denke, dass du es haben möchtest. Verglichen werden die Zellen Blatt2 A2 bis D2 mit den Zellen Blatt1 A9 bis D9 und die weiteren Zeilen. Bei Übereinstimmung aller 4 Zellen von Blatt2 mit denen von Blatt1 werden die Berechnungen durchgeführt.
Sub Zwei_Größten_Werte_ausgeben()
Dim a As Long, b As Long, c As Long, d As Long, i As Long, j As Long, aa As Long
Dim letztezeile As Long, Zähler As Long
Dim wert1 As String, wert2 As String
Dim rngWo As Range
With Sheets("Tabelle1")
'geändert, da UsedRange ein unsicherer Kandidat beim Feststellen der letzten Zeile ist
letztezeile = .Cells(Rows.Count, 1).End(xlUp).Row
'die letzte Zeile wird in Spalte A festgestellt, ggf. anpassen
For j = 9 To letztezeile
Zähler = 0
For i = 1 To 4 'Spalten 1 bis 4
wert1 = Sheets("Tabelle2").Cells(2, i).Value
Set rngWo = .Cells(j, i).Find(wert1, LookIn:=xlValues, Lookat:=xlPart)
If Not rngWo Is Nothing Then
Zähler = Zähler + 1
End If
Next i
If Zähler = 4 Then
If .Cells(j, 1) Like "*ja*" Then
a = 2
ElseIf .Cells(j, 1) Like "*jein*" Then
a = 1
Else
a = 0
End If
If .Cells(j, 2) Like "*ja*" Then
b = 2
ElseIf .Cells(j, 2) Like "*jein*" Then
b = 1
Else
b = 0
End If
If .Cells(j, 3) Like "*ja*" Then
c = 2
ElseIf .Cells(j, 3) Like "*jein*" Then
c = 1
Else
c = 0
End If
If .Cells(j, 4) Like "*ja*" Then
d = 2
ElseIf .Cells(j, 4) Like "*jein*" Then
d = 1
Else
d = 0
End If
aa = a * .Cells(2, 2) + b * .Cells(3, 2) + c * .Cells(4, 2) + d * .Cells(5, 2)
.Cells(j, 5) = aa
End If
Next j
End With
End Sub
Gruß Werner
Anzeige
AW: Größten Wert merken und ausgeben
28.07.2016 10:32:48
ViGo
Hallo Werner!
Entschuldige, dass ich mich erst jetzt melde! Ich war gestern den ganzen Tag im Zug und hab mich jetzt erst wieder rangesetzt. Doch, doch ich hab großes Interesse an der Lösung des Problems!
Ich sehe grad, du hast das mit der FIND- Methode umgesetzt. Die hatte mich auch schon angelächelt... Ist glaub ich auch schneller oder?
Ich werd das gleich mal ausprobieren und meld ich wieder! Diesmal auch etwas schneller!
Viele Grüße und vielen Dank, dass du dir das anschaust und mir hilfst!
ViGo
AW: Größten Wert merken und ausgeben
28.07.2016 20:20:09
Werner
Hallo,
mir ist da noch was aufgefallen. Du hast deine Variable aa für das Ergebnis als Long definiert. Long gibt dir eine Ganzzahl aus, du multiplizierst aber mit Kommazahlen. Das Ergebnis für die erste Zeile in deiner Beispielmappe wäre 2,3 durch die Definition als Long erhälst du aber 2. Ist das so gewollt?
Wenn nicht müsste die Variable aa als Single oder Double definiert sein.
Gruß Werner
Anzeige
AW: Größten Wert merken und ausgeben
28.07.2016 22:23:59
ViGo
Wie witzig! :D :D :D
Und ich frag mich die ganze Zeit wieso VBA falsch rechnet!
Hab schon an meinen Grundrechenkenntnissen gezweifelt! Zelle Formatieren hat natürlich auch nichts gebracht!
Das erklärts natürlich! Jetzt läufts auch! :) :) :)
Vielen, vielen Dank für deine Hilfe!!!
Auf die Sache mit dem Zähler wäre ich übrigens nie gekommen! So recht versteh ichs noch nicht, aber wenn man ihn ausklammert, funktionierts nicht. Kannst du mir das vielleicht noch erklären, wenn du noch magst?
Ist aber kein muss!
Viele Grüße, ViGo
AW: Größten Wert merken und ausgeben
28.07.2016 23:07:03
Werner
Hallo,
gerne doch. Ist eigentlich ganz einfach. Du ja prüfen, ob alle 4 Zellen A2 bis D2 Blatt 2 mit den Zellen A9 bis D9 Blatt 1 übereinstimmen.
Erstes Paar prüfen, bei Übereinstimmung Zähler auf 1, nächstes Paar Übereinstimmung Zähler auf 2 ....
Wenn nach Durchlauf der Zähler = 4 dann stimmen alle Zellen überein.
Gruß Werner
AW: Größten Wert merken und ausgeben
28.07.2016 23:41:51
ViGo
Achso, alles klar. Klingt logisch!
Vielen Dank nochmal für deine Hilfe!
Du hast mir damit sehr geholfen!
Viele Grüße, ViGo
AW: Gerne u. Danke für die Rückmeldung. o.w.T
29.07.2016 08:48:02
Werner

305 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige