Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 14:05:48
Makro in aktueller Zelle ausführen mit Doppelklick
25.04.2024 12:56:25
Werte von Kunden und Artikel stehen untereinander
25.04.2024 12:55:42
Funktionsparameter auslesen
25.04.2024 11:49:37
Array verwenden
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
656to660
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
656to660
656to660
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Mehrfacheinträge aus Liste filtern

Mehrfacheinträge aus Liste filtern
28.08.2005 15:14:01
Lian
Hallo,
ich suche nach einer Möglichkeit aus einer Liste mit zahlreichen Einträgen die doppelten Einträge separat darzustellen. Die Suche bezieht sich lediglich auf alle Einträge einer einzigen Spalte. Wenn ein dort gelisteter Eintrag zum Beispiel 3 mal vorhanden ist, soll dieser auf einem weiteren Tabellenblatt dargestellt werden (z.B. "Position0815 (3x)"). Um die Ergebnisliste der 2. Seite nicht zu überfüllen, wäre es ratsam nur alle Einträge zu listen, die mind. 2mal existieren.
Kann mir jemand hierfür eine Makrolösung anbieten?
Besten Dank im Voraus und einen guten Start in die neue Woche wünsche ich!

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Mehrfacheinträge aus Liste filtern
28.08.2005 15:25:47
Josef Ehrensberger
Hallo Lian!
ZB. so!
Sub DoppelteListen()
    Dim lRow As Long, n As Long
    Dim lastRow As Long
    Dim wksQ As Worksheet, wksZ As Worksheet
    
    Set wksQ = Sheets("Quelle") '<-- Name anpassen
    Set wksZ = Sheets("Ziel") '<-- Name anpassen
    
    lastRow = wksQ.Cells(65536, 1).End(xlUp).Row
    
    For n = 1 To lastRow
        If Application.CountIf(wksQ.Range(wksQ.Cells(1, 1), wksQ.Cells(lastRow, 1)), wksQ.Cells(n, 1)) > 1 Then
            lRow = lRow + 1
            wksZ.Cells(lRow, 1) = wksQ.Cells(n, 1) & " (" & Application.CountIf(wksQ.Range(wksQ.Cells(1, 1), _
                wksQ.Cells(lastRow, 1)), wksQ.Cells(n, 1)) & "x)"
        End If
    Next
End Sub



Gruß Sepp

P.S.: Rückmeldung nicht vergessen!

Anzeige
AW: Mehrfacheinträge aus Liste filtern
28.08.2005 15:47:23
Josef Ehrensberger
Hallo Lian!
Und so ohne Doppelte auflistung!
Sub DoppelteListen()
    Dim lRow As Long, n As Long, i As Long
    Dim lastRow As Long
    Dim wksQ As Worksheet, wksZ As Worksheet
    
    
    Set wksQ = Sheets("Quelle") '<-- Name anpassen
    Set wksZ = Sheets("Ziel") '<-- Name anpassen
    
    lastRow = wksQ.Cells(65536, 1).End(xlUp).Row
    lRow = 1
    
    For n = 1 To lastRow
        If Application.CountIf(wksQ.Range(wksQ.Cells(1, 1), wksQ.Cells(lastRow, 1)), wksQ.Cells(n, 1)) > 1 Then
            If Application.CountIf(wksZ.Range(wksZ.Cells(1, 1), wksZ.Cells(lRow, 1)), wksQ.Cells(n, 1)) = 0 Then
                wksZ.Cells(lRow, 1) = wksQ.Cells(n, 1)
                wksZ.Cells(lRow, 2) = "(" & Application.CountIf(wksQ.Range(wksQ.Cells(1, 1), _
                    wksQ.Cells(lastRow, 1)), wksQ.Cells(n, 1)) & "x)"
                lRow = lRow + 1
            End If
        End If
    Next
End Sub



Gruß Sepp

P.S.: Rückmeldung nicht vergessen!

Anzeige
was für ein Tag....
28.08.2005 17:01:35
Lian
Hallo Sepp,
ersteinmal besten Dank für die kurzfristige Lösung.
Da erhalte ich in kürzester Zeit solch eine tolle Lösung und es gelingt mir einfach nicht, sie richtig anzuwenden. Ich erläutere dir einfach nochmal meinen Wunsch im Detail - ich packs heut einfach nicht mehr. :-( Und morgen ist Montag - hoffentlich bin ich dann wenigstens wieder geistig voll da!
Er soll im Quellblatt die Spalte B nach doppelten Einträgen von Zeile 11 bis xx durchsuchen. Die doppelten Werten aus der Spalte B soll er die Anzahl und ein "x" anhängen und diese dann im Zielblatt in Spalte F ab Zeile 4 abwärts auflisten.
Das ist mir jetzt schon peinlich aber auch nach einem erneutem Versuch gelangs mir einfach net.
Anzeige
AW: was für ein Tag....
28.08.2005 17:34:36
Josef Ehrensberger
Hallo Lian!

Ein Beispiel!

Die Datei https://www.herber.de/bbs/user/26109.xls wurde aus Datenschutzgründen gelöscht


Gruß Sepp

P.S.: Rückmeldung nicht vergessen!

kleine Details
28.08.2005 18:23:56
Lian
Besten Dank - Sie sind ein Schatz!
Ich habe die einzelnen Zellangaben im Quelltext gegen Variablen ersetzt. Nur bei einer "4" im Quelltext gelang es mir nicht sie gegen die neue Variable "resultRow" zu ersetzen.
Die Definition von wksZ.Range konnte ich ebenso leider nicht (ohne danach auftretende Fehlfunktionen nach Ablauf des Makros) mit den Variablen ersetzen.
Die Ursachen dafür sind mir allerdings nicht ersichtlich.
Anlage: https://www.herber.de/bbs/user/26111.xls
Anzeige
AW: kleine Details
28.08.2005 18:44:30
Josef Ehrensberger
Hallo Lian!
dazu braucht's nur noch eine zusätzliche Variable!
Sub DoppelteListen()
Dim resultStartRow As Long, resultRow As Long, n As Long
Dim startRow As Long, lastRow As Long
Dim searchcol As Integer, resultCol As Integer
Dim wksQ As Worksheet, wksZ As Worksheet

Set wksQ = Sheets("Quelle") '<-- Name anpassen
Set wksZ = Sheets("Ziel") '<-- Name anpassen

startRow = 11 'Startzeile in "Quelle"
searchcol = 2 'zu durchsuchende Spalte in "Quelle"
lastRow = wksQ.Cells(65536, searchcol).End(xlUp).Row 'Letzte Zeile in "Quelle"
resultStartRow = 4 'Startzeile in "Ziel"
resultRow = resultStartRow
resultCol = 6 'Startspalte in "Ziel"

wksZ.Range(wksZ.Cells(resultStartRow, resultCol), _
  wksZ.Cells(Rows.Count, resultCol)).ClearContents 'Zielbereich leeren

For n = startRow To lastRow
  'Doppelte suchen und eintragen
  If Application.CountIf(wksQ.Range(wksQ.Cells(startRow, searchcol), _
    wksQ.Cells(lastRow, searchcol)), wksQ.Cells(n, searchcol)) > 1 Then
    If Application.CountIf(wksZ.Range(wksZ.Cells(resultStartRow, resultCol), _
      wksZ.Cells(resultRow, resultCol)), wksQ.Cells(n, searchcol)) = 0 Then
      wksZ.Cells(resultRow, resultCol) = wksQ.Cells(n, searchcol)
      resultRow = resultRow + 1
    End If
  End If
Next

For n = resultStartRow To resultRow - 1
  'An die Doppelten noch das (Xx) anhängen
  wksZ.Cells(n, resultCol) = wksZ.Cells(n, resultCol) & _
    " (" & Application.CountIf(wksQ.Range(wksQ.Cells(startRow, searchcol), _
    wksQ.Cells(lastRow, searchcol)), wksZ.Cells(n, resultCol)) & "x)"
Next

End Sub



Gruß Sepp
Anzeige
AW: kleine Details
29.08.2005 17:40:27
lian
Hallo Herr Ehrensberger.
Entschuldigen Sie bitte vielmals die lange Wartezeit aber es war mir einfach nicht eher möglich Ihnen zu antworten.
Ich habe den Quellcode noch etwas angepasst (heute hat es geklappt :) und es funktioniert soweit.
Nun hätte ich noch ein weiteres unspektakuläreres Anliegen, was ich aber besser in einem neuen Thread poste!?
Ich kann es ja dennoch mal anklingen lassen - evtl. haben sie eine Lösung Antwort parat. Ich Suche nach einer Maske mit der man nach den Einträgen aus der besagten Spalte suchen kann und die einen dann das Ergebnis in der Liste markiert (was nicht so schwierig ist!?) aber bei doppelten Werten den am weitesten unteren sucht. Idealerweise würde die Suche deshalb am Ende der Liste beginnen. Sie soll auch wieder in der Spalte suchen wie die Suche nach den doppelten Einträgen. Bei keinem Treffer in der Suche der besagten Spalte soll sie dem Nutzer die Wahl zwischen Anzeigen der Tabelle oder dem automatischen Schließen bieten.
Dies aber nur als Anklang!
Ich danke Ihnen vielmals für Ihre bisherige Hilfe!
Besten Dank!
Anzeige

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige