Gruppen

Top Gruppen: Windows 7; Windows Vista; Windows XP; Textverarbeitung; Excel; DSL; Internet Browser; E-Mail/Outlook
Betriebsysteme: Windows classik; Linux; BS-Sonstige
Software: Datenbanken; Bildbearbeitung; Audio/mp3/Video; Security/Viren; SW-Sonstige
Hardware: Mainboard/CPU; Grafikkarten; Peripherie; Laptop/Notebook; HW-Sonstiges
Netzwerk: Telefon,ISDN,Modem; W-Lan; NW-Sonstiges
Programmierung: PHP,ASP,Perl...; Java,C++...; Webseiten/HTML
Sonstiges: PC-Sonstiges; Plauderecke; SN Intern; Test

/ Forum / Tabellenkalkulation

Tabellenkalkulation

Fragevon Aggi11 vom 07.10.2021, 08:19 Options

Zellen auslesen

Hallo,

ich habe ein kleines Problem. Ich möchte bestimmte Daten aus einem Tabellenblatt in ein neues kopieren. Die Tabelle sieht wie folgt aus:

Spalte B = Materialnummern (ca. 400 unterschiedliche) es können jedoch auch mehrere gleiche Nummern untereinander stehen)
Spalte M = Datum

Nun möchte ich die nur die Zeile der unterschiedlichen Materialnummern mit dem letzten Datum in ein neues Tabellenblatt kopieren.

Könnt ihr mir helfen?

MfG

Aggi

Antwort schreiben

Antwort 1 von coros vom 07.10.2021, 09:20 Options

Hallo Aggi,

nachfolgendes Makro sortiert Dir das tabellenblatt mit dem Namen "Tabelle1", Spalte A. Danach wird über eine Schleife die Daten geprüft und nur jeweils ein Datensatz von Mehrfach-Datensätzen in das Tabellenblatt "Tabelle2", Spalte A in die erste freie Zeile.

Kopiere das Makro in ein StandardModul und starte es z.B. über eine Befehlsschaltfläche
Teste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.

Option Explicit Sub Prüfen_kopieren() Dim lngRow As Long Dim lngLastRow As Long Dim lngFirstFreeRow As Long Application.ScreenUpdating = False lngLastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row Sheets("Tabelle2").Range("A1") = Sheets("Tabelle1").Range("A1") Sheets("Tabelle1").Range("A1:A" & lngLastRow).Sort Key1:=Range("A2"), _ Order1:=xlAscending, Header:=xlYes For lngRow = 2 To lngLastRow If Cells(lngRow, 1) <> Cells(lngRow - 1, 1) Then lngFirstFreeRow = Sheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row Sheets("Tabelle1").Cells(lngRow, 1).Copy Sheets("Tabelle2").Cells(lngFirstFreeRow, 1) End If Next End Sub
Blattnamen und Bereich musst Du natürlich noch anpassen.

Solltest Du nicht wissen, wie Du den Code in Deine Datei bekommst, dann schau mal auf meiner HP in der Rubrik Anleitungen und dort dann in der Anleitungsnummer 3 nach. Dort stelle ich dazu eine bebilderte Anleitung zur Verfügung, die Dir sicherlich helfen wird.

Bei Fragen melde Dich.

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du}
^{ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Antwort 2 von Aggi11 vom 07.10.2021, 09:35 Options

Hallo Oliver,

vielen Dank für deine schnelle Antwort. Das Makro funzt auch einwandfrei, aber ich möchte die komplette Zeile mit den Materialnummern des letzten Datums (steht in Zeile "M") kopieren.

Kannst du mir auch hierbei weiterhelfen?

MfG

Aggi

Antwort 3 von coros vom 07.10.2021, 10:04 Options

Hallo Aggi,

was genau möchtest Du denn nun? Beschreibe das etwas genauer. Mache Angaben zu Deiner Datei. Denn ansonsten kommt wieder etwas heraus, was Du so nicht haben wolltest, bzw. bei Deiner Datei so nicht angewandt werden kann. Eventuell lädst Du z.B. bei http://www.file-upload.net/ Deine Datei hoich und postest hier den Link, den Du erhälst. Denn wie Du siehst, funktioniert das Makro, eben nur bei Deiner Datei nicht wie Du es Dir gedacht hast.

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du}
^{ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Antwort 4 von Aggi11 vom 07.10.2021, 10:39 Options

Hallo Oliver,

hier ist der Link zu meiner Tabelle.

http://www.file-upload.net/download-1931025/Standardpreisermittlung.xls.html

Nun möchte ich die Zeilen mit den Materialnummern (Spalte "B")des aktuellen Datums (Spalte"K") in eine neue Tabelle kopieren.

MfG

Aggi

Antwort 5 von coros vom 07.10.2021, 10:56 Options

Hallo Aggi,

das sollte nun mit nachfolgendem Makro funktionieren.

Kopiere das Makro in ein StandardModul und starte es z.B. über eine Befehlsschaltfläche
Teste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.

Option Explicit Sub Prüfen_kopieren() Dim lngRow As Long Dim lngLastRow As Long Dim lngFirstFreeRow As Long Application.ScreenUpdating = False lngLastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row Sheets("Tabelle3").Range("A1") = Sheets("Standartpreis Ermittlung").Range("A1") With Sheets("Standartpreis Ermittlung") .Range("A1:K" & lngLastRow).Sort _ Key1:=.Range("B2"), Order1:=xlAscending, _ Key2:=.Range("K2") _ , Order2:=xlDescending, Header:=xlGuess End With For lngRow = 2 To lngLastRow If Cells(lngRow, 1) <> Cells(lngRow - 1, 1) Then lngFirstFreeRow = Sheets("Tabelle3").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row Sheets("Standartpreis Ermittlung").Rows(lngRow).Copy Sheets("Tabelle3").Cells(lngFirstFreeRow, 1) End If Next End Sub
Ich hoffe, es klappt bei Dir. Bei mir hats funktioniert.

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du}
^{ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Antwort 6 von Aggi11 vom 07.10.2021, 11:42 Options

Hi Oliver,

ich weiß das ich nerve aber jetzt möchte ich die doppelten Materialnummern (Spalte "B") noch löschen, so das jede Materialnummer mit dem neuesten Datum (Spalte "K") nur noch einmal aufgelistet wird.

MfG

Aggi

Antwort 7 von malSchauen vom 07.10.2021, 11:58 OptionsLösung

Hi,

@Oliver (coros)
Kann es sein, dass sich die For-Schleife an der falschen Spalte orientiert? Aggi (Aggi11) wollte unique Materialnummern (Spalte B). Zu allem Überfluss hat er bei den Bestellungen (Spalte A) leere Zellen (lngFirstFreeRow-Ermittlung).

@Aggi (Aggi11)
Ändere beim Code aus AW5 die For-Schleife wie folgt:

For lngRow = 2 To lngLastRow
    If Cells(lngRow, 2) <> Cells(lngRow - 1, 2) Then
        lngFirstFreeRow = Sheets("Tabelle3").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row
        Sheets("Standartpreis Ermittlung").Rows(lngRow).Copy Sheets("Tabelle3").Cells(lngFirstFreeRow, 1)
    End If
Next

Dann sollte das Ergebnis passen.

bye
malSchauen

Antwort 8 von Aggi11 vom 07.10.2021, 13:25 Options

Hi,

so funktioniert es.

vielen Dank für eure Hilfe!!

MfG

Aggi

Hinweis

Diese Frage ist schon etwas älter, Sie können daher nicht mehr auf sie antworten. Sollte Ihre Frage noch nicht gelöst sein, stellen Sie einfach eine neue Frage im Forum..