Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1632to1636
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

@Barbaraa => Dankepost

@Barbaraa => Dankepost
11.07.2018 15:56:45
Kisska
Hallo Barbara,
danke für deine Unterstützung zu meinem Beitrag:
https://www.herber.de/cgi-bin/callthread.pl?index=1628812
Sorry, ich hatte private Probleme und konnte mich daher nicht rechtzeitig melden.
Auch wenn die Zeit längst verstrichen ist, kurz meine Rückmeldung:
Das Beispiel stamm tatsächlich von mir.
Deine Lösung habe ich ausprobiert, aber nur in den Spalten "01.01.201" und "02.01.2018" wurden die die richtigen Zellen markiert. In der Spalte "03.01.2018" hätten F5, F11 und F13 hervorgehoben werden müssen.
Auch wenn es mit der Lösung nicht ganz geklappt hat, lieben Dank für deine wertvolle Zeit!
VG
Kisska

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: @Barbaraa => Dankepost
12.07.2018 20:55:17
Barbaraa
Hallo Kisska,
gern geschehen.
Kann Deine Einwände nicht nachvollziehen, da ich die Beispieldatei aus dem Archiv nicht runter laden kann. Daher kann ich meinen Fehler nicht korrigieren.
Du müsstest Dein Problem in einem neuen Beitrag (nicht hier als Antwort) wieder vorstellen. Aber erst, wenn Du weißt, dass Du für die Antworten auch Zeit hast.
LGB
Hier die Datei
13.07.2018 12:43:47
lupo1
https://www.herber.de/bbs/user/122131.xlsx
(ich konnte sie öffnen, ohne mich damit beschäftigen zu wollen)
Die callthread-Verlinkungen führen (immer oder oft) zur Sonderzeichen-Verstümmelung. Bitte nicht verwenden!
Herber korrekt verlinken:
www.herber.de/forum/archiv/1592to1596/t1592601.htm
Anzeige
AW: Hier die Datei
13.07.2018 22:30:36
Barbaraa
Danke Lupo, für Deine Hilfe.
Ich habe ein Problem mit diesem Forum bezüglich der Darstellung der Beiträge im Archiv.
Manchmal kann ich diese Beiträge NICHT textlich bearbeiten, also Text markieren und kopieren, oder Links anklicken. Wie als wäre es ein Bild. Ist aber erst ab der Thread-Überschrift. Alles darüber funktioniert immer.
Manchmal kann ich.
Gestern konnte ich nicht, heute kann ich. Ein seltsames Firefox-Verhalten?
Es passiert sogar in der selben Sitzung, dass es nicht ging, dann einige Zeit später ging es: Archivthread aufrufen und beliebigen Text markieren.
Welches Ereignis oder welche Aktion den Fehler behebt, habe ich noch nicht herausgefunden.
Jetzt kann ich jedenfalls Kisskas Frage beantworten. Hoffentlich lässt sie sich nicht wieder so viel mit der Antwort Zeit.
LGB
Anzeige
AW: @Barbaraa => Dankepost
13.07.2018 22:35:17
Barbaraa
Hallo Kisska,
dank Lupos Hilfe konnte ich wieder Zugang zu Deiner Datei finden.
Probier mal folgenden Code:
Sub Gruppenumsatz()
Dim aProduktgruppen                 'Liste der Produktgruppen
Dim aBereiche                       'Liste der Bereiche
Dim lSpalte             As Long     'Datumspalte
Dim lZeile              As Long     'Produktzeile
Dim dUmsatz             As Double   'Umsatzsummen
Dim lBereich            As Long     'Bereich des größten Umsatzes
Dim i As Long, j As Long
aProduktgruppen = Liste(2)
aBereiche = Liste(3)
'   aSammlung(Produktgruppe, Bereich)=Umsatz
ReDim aSammlung(0 To UBound(aProduktgruppen), 0 To UBound(aBereiche))
For i = 0 To UBound(aProduktgruppen)
aSammlung(i, 0) = aProduktgruppen(i)
Next i
For i = 0 To UBound(aBereiche)
aSammlung(0, i) = aBereiche(i)
Next i
For lSpalte = 4 To Range("C3").End(xlToRight).Column
'   Umsätze löschen
For i = 1 To UBound(aSammlung, 1)
For j = 1 To UBound(aSammlung, 2)
aSammlung(i, j) = 0
Next j
Next i
'   Umsatzsummen bilden
For lZeile = 4 To Range("C3").End(xlDown).Row
For i = 1 To UBound(aSammlung, 1)
If aSammlung(i, 0) = Cells(lZeile, 2) Then
For j = 1 To UBound(aSammlung, 2)
If aSammlung(0, j) = Cells(lZeile, 3) Then
aSammlung(i, j) = aSammlung(i, j) + Cells(lZeile, lSpalte)
i = 0
Exit For
End If
Next j
If i = 0 Then Exit For
End If
Next i
Next lZeile
'   Umsätze markieren
For i = 1 To UBound(aSammlung, 1)
dUmsatz = 0
For j = 1 To UBound(aSammlung, 2)
If aSammlung(i, j) > dUmsatz Then
dUmsatz = aSammlung(i, j)
lBereich = j
End If
Next j
For lZeile = 4 To Range("C3").End(xlDown).Row
If Range("B" & lZeile) = aSammlung(i, 0) Then
If Range("C" & lZeile) = aSammlung(0, lBereich) Then
Cells(lZeile, lSpalte).Interior.Color = vbYellow
End If
End If
Next lZeile
Next i
Next lSpalte
End Sub
Private Function Liste(lSpalte As Long)
Dim i           As Long
Dim lZeile      As Long
Dim aVerzeichnis
ReDim aVerzeichnis(0)
For lZeile = 4 To Range("C3").End(xlDown).Row
For i = 0 To UBound(aVerzeichnis)
If aVerzeichnis(i) = Cells(lZeile, lSpalte) Then Exit For
Next i
If i > UBound(aVerzeichnis) Then
ReDim Preserve aVerzeichnis(i)
aVerzeichnis(i) = Cells(lZeile, lSpalte)
End If
'        lZeile = lZeile + 1
Next lZeile
Liste = aVerzeichnis
End Function
Der einzige Unterschied zum vorigen Code ist eine einzige Zeile.
Ganz unten habe ich eine Zeile auskommentiert, also ausser Kraft gesetzt. Diese Zeile war zu viel. Blöder Fehler von mir.
Jetzt sollte es funktionieren. Tut es das?
LGB
Anzeige
Funktioniert :-)
16.07.2018 22:07:11
Kisska
Schönen Abend Barbara,
klasse, jetzt funktioniert der Code einwandfrei! Besten Dank dafür!
Wäre es möglich, statt die Zellen hervorheben zu lassen, die Zellwerte zu überschreiben? Die nicht-gelben sollen dann leer bleiben. Vorher vielleicht die Originaltabelle in ein anderes Tabellenblatt kopieren und den Code dann bei der kopierten Tabelle anwenden.
Falls dies zu großer Programmieraufwand ist, dann bin ich auch mit der ersten Lösung glücklich.
Viele Grüße
Kisska
AW: Funktioniert :-)
16.07.2018 22:54:31
Barbaraa
Mit diesem Code bleiben die Superhelden stehen, der Rest wird gelöscht.
Option Explicit
Sub Gruppenumsatz()
Dim aProduktgruppen                 'Liste der Produktgruppen
Dim aBereiche                       'Liste der Bereiche
Dim lSpalte             As Long     'Datumspalte
Dim lZeile              As Long     'Produktzeile
Dim dUmsatz             As Double   'Umsatzsummen
Dim lBereich            As Long     'Bereich des größten Umsatzes
Dim i As Long, j As Long
aProduktgruppen = Liste(2)
aBereiche = Liste(3)
'   aSammlung(Produktgruppe, Bereich)=Umsatz
ReDim asammlung(0 To UBound(aProduktgruppen), 0 To UBound(aBereiche))
For i = 0 To UBound(aProduktgruppen)
asammlung(i, 0) = aProduktgruppen(i)
Next i
For i = 0 To UBound(aBereiche)
asammlung(0, i) = aBereiche(i)
Next i
For lSpalte = 4 To Range("C3").End(xlToRight).Column
'   Umsätze löschen
For i = 1 To UBound(asammlung, 1)
For j = 1 To UBound(asammlung, 2)
asammlung(i, j) = 0
Next j
Next i
'   Umsatzsummen bilden
For lZeile = 4 To Range("C3").End(xlDown).Row
For i = 1 To UBound(asammlung, 1)
If asammlung(i, 0) = Cells(lZeile, 2) Then
For j = 1 To UBound(asammlung, 2)
If asammlung(0, j) = Cells(lZeile, 3) Then
asammlung(i, j) = asammlung(i, j) + Cells(lZeile, lSpalte)
i = 0
Exit For
End If
Next j
If i = 0 Then Exit For
End If
Next i
Next lZeile
'   Umsätze markieren
For i = 1 To UBound(asammlung, 1)
dUmsatz = 0
For j = 1 To UBound(asammlung, 2)
If asammlung(i, j) > dUmsatz Then
dUmsatz = asammlung(i, j)
lBereich = j
End If
Next j
For lZeile = 4 To Range("C3").End(xlDown).Row
If Range("B" & lZeile) = asammlung(i, 0) Then
If Range("C" & lZeile) = asammlung(0, lBereich) Then
'                        Cells(lZeile, lSpalte).Interior.Color = vbYellow    'Gelb
Else
Cells(lZeile, lSpalte) = ""                         'Löschen
End If
End If
Next lZeile
Next i
Next lSpalte
End Sub
Private Function Liste(lSpalte As Long)
Dim i           As Long
Dim lZeile      As Long
Dim aVerzeichnis
ReDim aVerzeichnis(0)
For lZeile = 4 To Range("C3").End(xlDown).Row
For i = 0 To UBound(aVerzeichnis)
If aVerzeichnis(i) = Cells(lZeile, lSpalte) Then Exit For
Next i
If i > UBound(aVerzeichnis) Then
ReDim Preserve aVerzeichnis(i)
aVerzeichnis(i) = Cells(lZeile, lSpalte)
End If
'        lZeile = lZeile + 1
Next lZeile
Liste = aVerzeichnis
End Function
Folgende Erklärung, falls Du es Dir aber doch anders überlegst:
Zwei Zeilen im Code sind extra beschriftet jeweils am Zeilenende: Eine Zeile mit "'Gelb" und eine mit "'Löschen".
Die erste ist für das gelb-Markieren verantwortlich, die andere für das Löschen.
Am Beginn der "'Gelb"-Zeile ist ein kleiner Strich (Apostroph). Das bedeutet, diese Zeile ist auskommentiert, also funktionslos. Es wird also nicht gelb markiert.
Gibst Du das Apostroph weg, wird sie ausgeführt.
Die "'Löschen"-Zeile ist aktiv. Willst Du nun vielleicht doch nicht löschen, setze einfach ein Apostroph davor. Dann bleibt alles stehen.
Jetzt ist alles so eingestellt, wie Du es zuletzt haben wolltest.
Auf die Gesundheit.
LG, Barbara
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige