Live-Forum - Die aktuellen Beiträge
Datum
Titel
23.04.2024 21:33:46
Nur farbige/nicht farbige Zellen markieren
23.04.2024 21:29:56
Bestimmte Zellen auf andere Arbeitsblätter kopieren
23.04.2024 17:41:19
Link erstellen mit Formel oder VBA?
23.04.2024 17:00:22
Summe und Ausgabe
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1128to1132
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1128to1132
1128to1132
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Formel gesucht | Herbers Excel-Forum

Formel gesucht
12.01.2010 10:47:23
Karin

Hallo zusammen,
ich schreibe heute meinen ersten Beitrag in dieses Forum.
Ich hoffe das ich das Problem für euch verständlich erklären kann.
Ich habe eine Datei mit Bestellungen von Lieferanten.
In dieser Datei kommen die Bestell-Nr. und die Bestell-Pos. mehrfach vor.
Sie unterscheiden sich nur durch das Bestell-Datum und die Bestell-Menge.
Ich möchte gerne erreichen, dass mir pro Bestell-Nr. die Zeile mit der höchsten Pos.-Nr.
aufgelistet wird.
Dabei soll das Datum , die Bestell-Nr., die Bestell-Pos, die Mengeneinheit , der Lieferant
und die Gesamtmenge der höchsten Position erscheinen.
Alle anderen Positionen können gelöscht werden oder brauchen nicht mehr sichtbar sein.
(siehe Beispiel)
Ich hoffe das Problem ist einigermaßen verständlich dargestellt.
Hat jemand von euch eine Idee?
Freundliche Grüße
Karin
Userbild

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

Betreff
Datum
Anwender
Anzeige
AW: Formel gesucht
12.01.2010 11:03:42
Rudi Maintaire
Hallo,
1. per Spezialfilter ohne Duplikate eine Liste aller Best-Nr erstellen.
2. die höchste Pos. per Matrixformel: {=MAX(($B$5:$B$21=B28)*$C$5:$C$21)}
3. die Summen: =SUMMENPRODUKT((B$5:B$21=B28)*(C$5:C$21=C28)*D$5:D$21)
Matrixformel: {} nicht eingeben, sondern Formel mit shift+strg+enter abschließen.
Gruß
Rudi
AW: Formel gesucht
12.01.2010 13:16:55
Karin
Hallo Rudi,
vielen Dank für die schnelle Antwort.
Ich werde es gleich mal ausprobieren.
Liebe Grüße
Karin
AW: Formel gesucht
12.01.2010 12:06:19
Josef Ehrensberger
Hallo Karin,
hier eine VBA lösung.
' **********************************************************************
' Modul: Modul1  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub listMax()
  Dim rng As Range, rngDel As Range
  Dim lngRow As Long, lngLast As Long
  
  On Error GoTo ErrExit
  Application.ScreenUpdating = False
  
  lngRow = 5 'erste Datenzeile
  
  lngLast = Application.Max(lngRow, Cells(Rows.Count, 1).End(xlUp).Row) 'letzte Datenzeile
  
  Columns(8).Insert
  Cells(lngRow, 8).FormulaArray = "=IF((C" & lngRow & "=MAX(IF($B$" & lngRow & _
    ":$B$" & lngLast & "=B" & lngRow & ",$C$" & lngRow & ":$C$" & lngLast & "))),C" _
    & lngRow & ","""")"
  Range(Cells(lngRow, 8), Cells(lngLast, 8)).FillDown
  
  Columns(9).Insert
  Cells(lngRow, 9).FormulaArray = "=IF(H" & lngRow & "="""","""",IF(A" & lngRow & _
    "=MAX(IF($C$" & lngRow & ":$C$" & lngLast & "=H" & lngRow & ",$A$" & lngRow & _
    ":$A$" & lngLast & ")),A" & lngRow & ",""""))"
  Range(Cells(lngRow, 9), Cells(lngLast, 9)).FillDown
  
  Columns(10).Insert
  Cells(lngRow, 10).Formula = "=IF(AND(H" & lngRow & "<>"""",I" & lngRow & _
    "<>""""),SUMIF($H$" & lngRow & ":$H$" & lngLast & ",H" & lngRow & ",$D$" & _
    lngRow & ":$D$" & lngLast & "),"""")"
  Range(Cells(lngRow, 10), Cells(lngLast, 10)).FillDown
  
  For Each rng In Range("J" & lngRow & ":J" & lngLast)
    If rng <> "" Then
      rng.Offset(0, -6) = rng.Value
    Else
      If rngDel Is Nothing Then
        Set rngDel = rng.EntireRow
      Else
        Set rngDel = Union(rngDel, rng.EntireRow)
      End If
    End If
  Next
  
  If Not rngDel Is Nothing Then rngDel.Delete
  
  Union(Columns(8), Columns(9), Columns(10)).Delete
  
  ErrExit:
  Application.ScreenUpdating = True
  Set rng = Nothing
  Set rngDel = Nothing
End Sub


Gruß Sepp
Anzeige
AW: Formel gesucht
12.01.2010 13:58:27
Karin
Hallo Josef,
vielen Dank für deine Antwort.
Ich bin begeistert was man mit VBA alles machen kann,-
vorausgesetzt man kennt sich da aus.,- so wie du.
Ich bin da vollkommen überfragt.
Ich hätte da noch mal eine Frage.
Das Makro läuft ja sauber durch.
Meine Liste die ich auszuwerten habe, besteht aus ca. 2000 Positionen
mit ca. 1400 unterschiedlichen Lieferanten.
Dann funktioniert das Makro aber nicht mehr, oder?
Kannst du das noch erweitern?
Oder ist das zuviel Arbeit?
Liebe Grüße
Karin
AW: Formel gesucht
12.01.2010 14:04:14
Josef Ehrensberger
Hallo Karin,
doch, das Makro fuktioniert auch bei deiner Liste, vorausgesetzt der Aufbau ist derselbe.
Gruß Sepp
Anzeige
AW: Formel gesucht
13.01.2010 10:49:02
Karin
Hallo Josef,
ich habe das ganze heute morgen noch mal durchgespielt,
und zwar habe ich die vorhandene Datei um 2 Sätze erweitert.
Ich habe den letzten Satz kopiert und einfach hinten 2 x angefügt.
In diesen beiden Sätzen habe ich dann nur die Bestell-Nr. geändert.
Das Makro hat aber die Änderung nicht verarbeitet.
Kannst du dir das erklären, oder mache ich was falsch?
Gruß
Karin
https://www.herber.de/bbs/user/67185.doc
https://www.herber.de/bbs/user/67186.xls
Anzeige
AW: Formel gesucht
13.01.2010 11:51:49
Josef Ehrensberger
Hallo Karin,
hab den Code nochmal überarbeitet.
' **********************************************************************
' Modul: Modul1  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit


Sub listMax()
  Dim rng As Range, rngDel As Range
  Dim lngRow As Long, lngLast As Long
  
  On Error GoTo ErrExit
  Application.ScreenUpdating = False
  
  lngRow = 5 'erste Datenzeile
  
  lngLast = Application.Max(lngRow, Cells(Rows.Count, 1).End(xlUp).Row) 'letzte Datenzeile
  
  Columns(8).Insert
  Cells(lngRow, 8).FormulaArray = "=IF((C" & lngRow & "=MAX(IF($B$" & lngRow & _
    ":$B$" & lngLast & "=B" & lngRow & ",$C$" & lngRow & ":$C$" & lngLast & _
    "))),C" & lngRow & ","""")"
  Range(Cells(lngRow, 8), Cells(lngLast, 8)).FillDown
  
  Columns(9).Insert
  Cells(lngRow, 9).FormulaArray = "=IF(H" & lngRow & "="""","""",IF(A" & lngRow _
    & "=MAX(IF(($B$" & lngRow & ":$B$" & lngLast & "=B" & lngRow & ")*($C$" & _
    lngRow & ":$C$" & lngLast & "=H" & lngRow & "),$A$" & lngRow & ":$A$" & _
    lngLast & ")),A" & lngRow & ",""""))"
  Range(Cells(lngRow, 9), Cells(lngLast, 9)).FillDown
  
  Columns(10).Insert
  Cells(lngRow, 10).Formula = "=IF(AND(H" & lngRow & "<>"""",I" & lngRow & _
    "<>""""),SUMPRODUCT(($B$" & lngRow & ":$B$" & lngLast & "=B" & lngRow & _
    ")*($H$" & lngRow & ":$H$" & lngLast & "=H" & lngRow & ")*$D$" & lngRow & _
    ":$D$" & lngLast & "),"""")"
  Range(Cells(lngRow, 10), Cells(lngLast, 10)).FillDown
  
  For Each rng In Range("J" & lngRow & ":J" & lngLast)
    If rng <> "" Then
      rng.Offset(0, -6) = rng.Value
    Else
      If rngDel Is Nothing Then
        Set rngDel = rng.EntireRow
      Else
        Set rngDel = Union(rngDel, rng.EntireRow)
      End If
    End If
  Next
  
  If Not rngDel Is Nothing Then rngDel.Delete
  
  Union(Columns(8), Columns(9), Columns(10)).Delete
  
  ErrExit:
  Application.ScreenUpdating = True
  Set rng = Nothing
  Set rngDel = Nothing
End Sub


Gruß Sepp
Anzeige
AW: Formel gesucht
14.01.2010 10:37:19
Karin
Hallo Josef,
ich komme leider erst jetzt dazu dein überarbeitetes VBA zu prüfen.
Es funktioniert super, vielen vielen Dank.
Bis zum nächsten Mal.
Lieber Grüße
Karin
AW: Formel gesucht
13.01.2010 11:56:58
welga
Hallo Karin,
mach dir mal eine Kopie deiner Tabelle und versuche den folgenden Code:
Sub auflistung()
Dim i As Long
Dim a As Long
Dim tabelle As Range
Set tabelle = Range(Cells(4, 1), Cells(Cells(4, 1).End(xlDown).Row, 4))
Range("A4:F4").Select
Selection.AutoFilter
Range("a1").Select
tabelle.Sort Key1:=Range("C4"), Order1:=xlDescending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
tabelle.Sort Key1:=Range("B4"), Order1:=xlDescending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
a = Cells(4, 1).End(xlDown).Row
For i = a To 5 Step -1
If Cells(i, 2) = Cells(i - 1, 2) Then
Rows(i).Delete Shift:=xlUp
'i = i + 1
End If
Next i
Set tabelle = Range(Cells(4, 1), Cells(Cells(4, 1).End(xlDown).Row, 4))
tabelle.Sort Key1:=Range("A4"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A4:F4").Select
Selection.AutoFilter
Range("A1").Select
End Sub
Aber vorsicht, dieser löscht dir alle Zeilen die du nicht haben willst.
Gruß
welga
Anzeige
@ Welga, und wo sind die summierten Werte? o.T.
13.01.2010 12:00:39
Josef Ehrensberger
Gruß Sepp
jetzt inkl. summierter Werte
13.01.2010 12:19:18
welga
Hallo,
ich hatte das ganz übersehen. Deshalb nun noch einmal:
Sub auflistung()
Dim i As Long
Dim ii As Long
Dim a As Integer
Dim tabelle As Range
Set tabelle = Range(Cells(4, 1), Cells(Cells(4, 1).End(xlDown).Row, 4))
Range("A4:F4").Select
Selection.AutoFilter
Range("a1").Select
tabelle.Sort Key1:=Range("C4"), Order1:=xlDescending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
tabelle.Sort Key1:=Range("B4"), Order1:=xlDescending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
ii = Cells(4, 1).End(xlDown).Row
For i = ii To 5 Step -1
a = 0
If Cells(i, 2) = Cells(i - 1, 2) Then
If Cells(i, 3) = Cells(i - 1, 3) Then
a = Cells(i, 4).Value + Cells(i - 1, 4).Value
Cells(i - 1, 4).Value = a
End If
Rows(i).Delete Shift:=xlUp
End If
Next i
Set tabelle = Range(Cells(4, 1), Cells(Cells(4, 1).End(xlDown).Row, 4))
tabelle.Sort Key1:=Range("A4"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A4:F4").Select
Selection.AutoFilter
Range("A1").Select
End Sub

Gruß
welga
Anzeige
AW: jetzt inkl. summierter Werte
14.01.2010 10:45:27
Karin
Hallo welga,
vielen Dank für die schnelle Antwort. Leider konnte ich dein VBA erste jetzt testen.
Bei mir kommt folgender Fehlermeldug hoch:
(siehe Anlage)
Gruß
Karin
Userbild
AW: jetzt inkl. summierter Werte
14.01.2010 10:46:40
Hajo_Zi
Hallo KArin,
lösche den Teil DataOption, den gibt es in Deiner Vesion noch nicht.

AW: jetzt inkl. summierter Werte
14.01.2010 12:48:35
Karin
Hallo Hajo,
vielen Dank, es hat geklappt.
Super !
Bis zum nächsten Mal.
Liebe Grüße
Karin

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige