Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

Excel Makro für AUswertung





Frage

Ich habe eine Tabelle zur Standzeitüberwachung von Werkzeugen . In Spalte A ( die Station ) in Spalte B ( die Bohrerbezeichnung ) usw. – bis zur Spalte E in der die Reststandzeit angezeigt wird. Nun sollen zur besseren Übersicht nur die Zeilen in denen im Feld E 2 bis E 180 eine Zahl die kleiner als 2000 ist in ein Tabellenblatt ( Name z.B. Auswertung ) kopiert werden , um sie auszudrucken . ( Ich drucke bisher alle aus was die Sache a) unübersichtlich und b) viel unnützes Papier kostet ). Kann jemand helfen oder hat jemand eine andere Idee ??

Antwort 1 von coros

Nabend Kurt Jürgens,

gestatte mir zum Anfang eine kleine Anmerkung. Ein Hallo am Anfang und ein Gruß am Ende würde Deinen Beitrag gleich viel netter aussehen lassen. Du gibst zwar Deine Frage am PC ein, die Leute, die am anderen Ende sitzen und Dir helfen, sind aber dennoch Menschen.

Nun zu Deiner Frage, kopiere nachfolgendes Makro in ein StandardModul und starte es über eine Schaltfläche.

Option Explicit

Sub Auswertmakro()
Dim Zeile As Long, Blattname_alt As String, _
Wiederholungen As Long
Application.ScreenUpdating = False
Blattname_alt = ActiveSheet.Name
Sheets.Add.Name = "Auswertung"
Sheets(Blattname_alt).Activate
For Wiederholungen = 2 To 180
If Cells(Wiederholungen, 5) < 2000 Then
Zeile = Sheets("Auswertung").Range("E65536"). _
End(xlUp).Offset(1, 0).Row
Rows(Wiederholungen).Copy _
Sheets("Auswertung").Cells(Zeile, 1)
End If
Next
End Sub


Bei dem Makro wird ein neues Blatt mit dem Namen "Auswertung" angelegt. Durch eine For/Next Schleife wird jede Zelle in Splate E nach ihrem Wert überprüft. Wenn der Wert kleiner 2000 ist, wird die gesamte Zeile in das Blatt "Auswertung" kopiert.

Wenn Du nicht weißt, wie Du den Code in Deine Exceldatei bekommst, dann schau mal auf meiner HP in der Rubrik Anleitungen und dort bei Anleitung zum VBA Projekt “Modul" nach. Die bebilderte Anleitung sollte Dir dabei helfen.

Ich hoffe, das makor ist so, wie Du es Dir vorgestellt hast. Wenn nicht oder bei Problemen melde Dich wieder.

MfG,
coros
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 Kurt - Jürgen

Erst einmal entschuldigung das ich das menschliche vergessen habe !!
War so damit beschäftigt mein Problem verständlich zu erklären das ich es vergessen habe.
Leider funktioniert das Makro noch nicht. Es macht ein Tabellenblatt mit dem Namen Auswertung auf und endet dann . Muss im Makro die Spalte E 2 bis E 180 nicht abgefragt werden ??

Sorry das ich noch mal nachfrage !!

Antwort 3 von Kurt - Jürgen

Entschuldigung es geht doch !!!

Es war mein Fehler !!!!!!!!!!

Besten Dank an alle !!

Antwort 4 von Kurt -Jürgen

erst mal vielen Dank für die Hilfe !!

Kann man auch nur Zeilen, die in Spalte A " rot oder gelb" formartiert sind ausdrucken ??
( a2 -a270 )
wenn möglich ohne ein extra Tabellenblatt anzulegen ??

tschuldigung wenn ich nerve aber um so mehr ich an dieser Tabelle arbeite um so mehr einfälle aber leider auch lösungen habe ich !!

Antwort 5 von coros

Hi Kurt Jürgens,

sorry erst mal, dass ich erst jetzt antworte, aber ich habe erst jetzt Zeit gefunden wieder im Forum vorbei zu schauen. Du nervst übrigens nicht. Das hier ist ein Forum, wenn jemand der Meinung ist, dass der Fragesteller nervt, der ist hier am falschen Platz. Allerdings finde ich es immer noch nicht OK, dass Du weder ein Hallo am Anfang, noch einen Gruß am Ende schreibst. Ich finde schon, dass diese Höflichkeit auch hier im Forum angewandt werden sollte.

Nun zu Deiner Frage, das geht schon, aber nicht ohne ein sepaates Tabellenblatt. Kopiere nachfolgendes Tabellenblatt in ein StandardModul und starte es wieder über eine Befehlsschaltfläche.

Sub Auswertmakro()
Dim Zeile As Long, Blattname_alt As String, _
Wiederholungen As Long
Application.ScreenUpdating = False
Blattname_alt = ActiveSheet.Name
Sheets.Add.Name = "Auswertung"
Sheets(Blattname_alt).Activate
For Wiederholungen = 2 To 270
If Cells(Wiederholungen, 1).Interior.ColorIndex = 6 Then
Zeile = Sheets("Auswertung").Range("A65536"). _
End(xlUp).Offset(1, 0).Row
Rows(Wiederholungen).Copy _
Sheets("Auswertung").Cells(Zeile, 1)
End If
Next
Sheets("Auswertung").PrintOut Copies:=1, Collate:=True
Application.DisplayAlerts = False
Sheets("Auswertung").Delete
Application.DisplayAlerts = True
End Sub


Bei dem Makro wird wieder ein neues Tabellenblatt angelegt. Dann werden die Zellen in Spalte A auf ihren Farbindex hin überprüft. Wenn dieser gelb ist (Farbindexzahl 6) dann wird die Zeile in das neue Tabellenblatt kopiert. Nachdem alle Zellen mit der Hintergrundfarbe gelb kopiert wurden, wird das neue Tabellenblatt gedruckt und anschließend das neue Tabellenblatt wieder gelöscht. Das gleiche Makro kannst Du auch für die Farbe rot verwenden, allerdings musst Du dann in dem Makro in der Zeile

If Cells(Wiederholungen, 1).Interior.ColorIndex = 6 Then

anstelle der Zahl 6 eine 3 angeben. Allerdings sind das die Farbindexzahlen für das richtige gelb und rot. Wenn Du andere Farbtöne verwendest, musst Du erst einmal den Farbindex ermitteln. Das kannst Du mit nachfolgendem Makro erledigen, welches Du in einem neuen Tabellenblatt ausführen solltest.

Sub Farbauswahl()
  Dim x As Byte
  For x = 1 To 56
    If x < 29 Then
      Cells(x, 1) = x
      Cells(x, 3) = x
      Cells(x, 4) = x
      Cells(x, 2).Interior.ColorIndex = x
      Cells(x, 3).Font.ColorIndex = x
      Cells(x, 4).Font.ColorIndex = x
    Else
      Cells(x - 28, 6) = x
      Cells(x - 28, 8) = x
      Cells(x - 28, 9) = x
      Cells(x - 28, 7).Interior.ColorIndex = x
      Cells(x - 28, 8).Font.ColorIndex = x
      Cells(x - 28, 9).Font.ColorIndex = x
    End If
  Next x
End Sub


Damit man für beide Farben nur ein Makro verwenden kann, könnte man die Farbindexzahl auch über eine InputBox eingeben. Wenn DU das so haben möchtest, dann melde Dich noch mal, ich werde Dir dann das entsprechende Makro erstellen.

Ich hoffe, es funktioniert alles. Bei Problemen melde Dich.

MfG,
coros
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 Kurt - Jürgen

Vielen Dank !!!
Setze mich gleich mal dran und werde testen !!

Antwort 7 von hgbeifel

Hallo an alle, besonders an die Helfer hier im Forum.
Alle Achtung für die Leistung. Bin neu hier und hoffe das ich alle Regeln beachte. Habe als Anfänger einmal das erste Makro in diesem Tread ausprobiert, da es für mich auch nützlich wäre. Unter Excel2000 hat es auch funktioniert, aber unter Excel97 bekomme ich die Fehlermeldung das die Typen nicht kompatibel sind. Ist dort unter Excel97 eine Anpassung notwendig? Und ist es möglich nur Spalten in die Auswertung zu geben, statt der ganzen Zeile?
Für Hilfe wäre ich dankbar.
mfg. hgbeifel

P.S. Hätte ich für diese Frage einen neuen Tread eröffnen sollen?

Antwort 8 von Kurt Juegen

Sorry aber das Makro macht bei mir immer nur die letzte Zeile in der eine Farbe steht.
Leider nicht alle, durch eine Farbe gekennzeichnete Zellen und somit markierte Zeilen auf dem Tabellenblatt.
Oder hab ich etwas verkehrt gemacht ??

Dank im Voraus
Eure Nervensäge !!

Antwort 9 von coros

Moin Ihr beiden!

@hgbeifel : Dir kann ich leider erst heute nachmittag helfen, da ich den Code erst mal unter Excel97 laufen lassen muss, um zu sehen, was falsch daran ist. Allerdings habe ich Excel97 nur auf einem alten Rechner bei mir zu hause und deshalb kann ich das erst nachmittags testen. Ich vermute mal, dass der Kopierbefehl falsch aufgebaut ist. Excel97 ist da etwas eigenwillig.

@Kurt Jürgens: Warum der Code bei Dir nicht funktioniert weiß ich jetzt auch nicht auf anhieb. Bei mir unter Excel2000 und Excel 2002 funktioniert er ohne Probleme. Unter welcher Excelversion soll das makro denn bei Dir laufen? Bedingung für den Code ist, dass die farbigen Zellen sich in Spalte A befinden. Dann müssen die Farben vom Farbton natürlich gleich sein, sprich wenn die eine Zelle gelb, die andere aber ein helleres gelb als Hintergrundfarbe hat, wird nur die eine Zelle gefunden, da sie die Farbindexzahl hat. Wenn Du mehrere Gelbtöne verwendest, müsste der Code noch mal umgearbeitet werden. Wenn Du es aber beim besten Willen nicht hinbekommen solltest, dann mache ich Dir das Angebot mir Deine Datei zu schicken, wenn sie keine Daten enthält, die dem Datenschutz unterliegen. Daten, die mich nichts angehen, kannst Du löschen oder gegen Dummytexte ersetzen, sofern die Daten für den reibungslosen Ablauf der Datei benötigt werden. Ich werde Dir dann den Code einbauen. Schicke die Datei an die E-Maiadrese:coros@excelbeispiele.de. Bitte binde in der Betreffzeile das Wort Supportnet mit ein, da ich alle Mails, deren Absender ich nicht kenne, ungelesen lösche.

MfG,
coros
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 10 von coros

Hi hgbeifel ,

wie versprochen kommt hier das Makro, so dass es unter Excel97 und natürlich auch unter allen anderen Excelversionen ab Excel97 aufwärts, läuft.

Sub Auswertung_und_ganze_Zeile_kopieren()
Dim Zeile As Long, Blattname_alt As String, _
Wiederholungen As Long
Application.ScreenUpdating = False
Blattname_alt = ActiveSheet.Name
Sheets.Add.Name = "Auswertung"
Sheets(Blattname_alt).Activate
For Wiederholungen = 2 To 270
If Cells(Wiederholungen, 1).Interior.ColorIndex = 6 Then
Zeile = Sheets("Auswertung").Range("A65536"). _
End(xlUp).Offset(1, 0).Row
Rows(Wiederholungen).Copy
Sheets("Auswertung").Cells(Zeile, 1).PasteSpecial _
Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=False
End If
Next
Sheets("Auswertung").PrintOut Copies:=1, Collate:=True
Application.DisplayAlerts = False
Sheets("Auswertung").Delete
Application.DisplayAlerts = True
End Sub


Da ich nicht ganz verstehe, was Du mit Deiner Frage

Zitat:
Und ist es möglich nur Spalten in die Auswertung zu geben, statt der ganzen Zeile?

meinst, schreibe ich hier noch mal selbiges Makro wie oben, allerdings kopiert das Makro nicht die ganze Zeile, sondern die Zelle in Spalte B, in der sich die Farbe gelb befinet. Kopiere nachfolgendes Makro ebenfalls in ein StandardModul und starte es über eine Befehlsschaltfläche.

Sub Auswertung_und_Zelle_in_Spalte_B_kopieren()
Dim Zeile As Long, Blattname_alt As String, _
Wiederholungen As Long
Application.ScreenUpdating = False
Blattname_alt = ActiveSheet.Name
Sheets.Add.Name = "Auswertung"
Sheets(Blattname_alt).Activate
For Wiederholungen = 2 To 270
If Cells(Wiederholungen, 1).Interior.ColorIndex = 6 Then
Zeile = Sheets("Auswertung").Range("A65536"). _
End(xlUp).Offset(1, 0).Row
Cells(Wiederholungen, 2).Copy
Sheets("Auswertung").Cells(Zeile, 1).PasteSpecial _
Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=False
End If
Next
Sheets("Auswertung").PrintOut Copies:=1, Collate:=True
Application.DisplayAlerts = False
Sheets("Auswertung").Delete
Application.DisplayAlerts = True
End Sub


Wenn Du eine andere Zelle als die aus Spalte B kopiert haben möchtest, dann musst Du in dem Makro in der Zeile

Cells(Wiederholungen, 2).Copy

die Zahl in Klammern ändern. Die Zahl sagt die Spalte aus. Eine 1 steht für Spalte A, eine 2 für Spalte B, eine 3 für Spalte C usw.

Sollte ich Deine Frage falsch verstanden haben und somit auch eine falsche Lösung hier hingeschrieben haben, dann melde Dich. Schreibe aber dann, was Du mit Deiner Frage gemeint hast.

MfG,
coros
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 11 von Kurt Jürgen

Hallo Coros !!
Ich denke ich bin dein Alptraum aber es will immer noch nicht.
habe Windows XP und Office XP daheim am Computer
an der Arbeit NT und Office 97
leider hat bisher keine Version gelaufen - letzte probiere ich morgen an der Arbeit unter Office 97
Ich habe heute eine einfache Tabelle erstellt :
Spalte A 2 bis A30 markiert und mit weiss gefüllt -
Spalte B2 bis H 30 mit Text und Zahlen
Dann habe ich im Makro nur den Farbwert auf 2 gesetzt. Starte ich das Makro druckt er mir nur wieder die Zeile 30 und nur die auf mein Blatt !!
Kann es an irgendwelchen Einstellungen im Excel liegen ?? Ist aber auch komisch da es unter beiden Office Versionen passiert . Hat es bei hgbeifel geklappt ??

Nochmal vielen Dank für die Bemühungen von Euch allen - besonders COROS

Antwort 12 von hgbeifel

Hallo coros, kurt-jürgen und andere Interessierte,

leider klappt es bei mir auch nicht . Auch nicht unter Excel2000 . Bei mir geht nur das erste Skript hier im Tread (ganz oben) wenn ich die anderen probiere passiert nix. Nur wenn ich mit F8 die Einzelschritte teste, wird die Seite Auswertung angelegt, aber nichts reingeschrieben. Schade denn die Bedingungen zum sortieren aus dem ersten Makro hätten mir schon gereicht, denn ich muß nichts mit Farbe in den Spalten machen oder übergeben.
Coros mit den Spalten hatte ich gemeint, das zum Beispiel nur die Spalte A,B und E in Seite Auswertung übergeben werden.
Trotzdem vielen Dank für die Mühe die Du dir gemacht hast.
Grüße hgbeifel

Antwort 13 von Knubbel

@ Coros,

wie schafft man es als 38jähriger zu so ungewohnten Zeiten (17:31, 15:44, 6:47 ,15:09) solch lange Beiträge in das Forum zu stellen?

Deine Hilfsbereitschaft ist doch wirklich beispielhaft!

Ich kann zu dem hier angsprochenen Problem keinen Beitrag leisten, aber deine Aufopferung finde ich schon überwältigend.

Danke, dass es solche Helfer hier im SN gibt.

mfg Knubbel

Antwort 14 von coros

Moin hgbeifel,

das der Code nicht funktioniert wird daran liegen, dass Du in Spalte A keine Daten zu stehen hast. Das ist aber bei den obigen Codes Bedingung. Nachfolgendem Code ist es egal, in welcher Spalte Daten stehen. Er ermittelt immer die erste freie Zeile in Blatt "Auswertung", damit die Daten in das Blatt in die nächste leere Zeile eingefügt werden können.

Sub Auswertung_und_ganze_Zeile_kopieren()
Dim Zeile As Long, Blattname_alt As String, _
Wiederholungen As Long
Application.ScreenUpdating = False
Blattname_alt = ActiveSheet.Name
Sheets.Add.Name = "Auswertung"
Sheets(Blattname_alt).Activate
For Wiederholungen = 2 To 270
If Cells(Wiederholungen, 1).Interior.ColorIndex = 6 Then
Zeile = Sheets("Auswertung").Cells.SpecialCells(xlLastCell).Row + 1
Rows(Wiederholungen).Copy
Sheets("Auswertung").Cells(Zeile, 1).PasteSpecial _
Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=False
End If
Next
Sheets("Auswertung").PrintOut Copies:=1, Collate:=True
Application.DisplayAlerts = False
Sheets("Auswertung").Delete
Application.DisplayAlerts = True
End Sub


Der Code funktioniert ab Excel 97 aufwärts.

Da Deine Antwort bezüglich der Spalten nicht aussagekräftig war, tappe ich mit der Lösung immer noch im Dunkeln. Wenn Du ganze Spalten kopieren möchtest, dann musst Du mit dem Column-Befehl arbeiten. Als Beispiel:

Columns(1).Copy

kopiert die Spalte A. Wenn Spalte B kopiert werden soll, dann die 1 gegen eine 2, bei Spalte C eine 3 usw. Wenn Du aber nur Werte aus verschiedenen Spalten anstelle der ganzen Zeile kopieren möchtest, dann musst Du so verfahren, wie in Antwort 10, 2. Makro beschrieben.
Wenn Dir die Antwort nicht genügt, dann musst Du schon mal etwas genauer werden, was Du erreichen möchtest.

@Knubbel: Danke Dir für Deine Blumen. Danke auch, dass Du mich jünger machst, bin mitlerweile 39, aber egal. ;-) Das ich zu einer so frühen Stunde hier antworte, liegt daran, dass ich einerseits Frühaufsteher bin und gestern, weil ich eine Rufbereitschaft hatte und Nacht´s raus musste. Zu der Zeit, als ich den Beitrag geschrieben habe, bin ich gerade nach Hause gekommen und konnte nicht mehr schlafen. Un heute bin ich mal wieder Frühaufsteher, ist so eine Gewohnheit.

MfG,
coros
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 15 von coros

Hi ,

nachdem ich vorhin Deine Mail an mich gelesen habe und mir Deine angehängte Datei angesehen habe, habe ich das Problem, warum der Code bei Dir nicht funktioniert, entdeckt. Das liegt daran, dass in einem Teile Deiner Zelle ein Leerzeichen und in einem anderen Teil in den Zellen Formeln stehen. Daher kann die If-Abfrage auf die Zahl 0 nicht funktionieren. Die If-Abfrage muss auf Text erfolgen. Nun hätte ich Dir die geänderte Datei gerne zurückgeschickt. Leider erhalte ich eine Fehlermeldung, wenn ich versuche Dir eine Mail zu schicken. Warum weiß ich nicht, es wird mir gemeldet dass eine Störung aufgetreten ist. Deshalb poste ich hier jetzt das Makro, so wie ich es abgeändert habe und wie es unter Excel97 läuft.

Sub Auswertmakro()
Dim Zeile As Long, Blattname_alt As String, _
Wiederholungen As Long
Application.ScreenUpdating = False
Blattname_alt = ActiveSheet.Name
Sheets.Add.Name = "Auswertung"
Sheets(Blattname_alt).Activate
For Wiederholungen = 5 To 450
If Cells(Wiederholungen, 8) > " " Then
Zeile = Sheets("Auswertung").Range("A65536"). _
End(xlUp).Offset(1, 0).Row
Range("A" & Wiederholungen & ",B" & Wiederholungen & ",H" & Wiederholungen).Copy
Sheets("Auswertung").Cells(Zeile, 1).PasteSpecial Paste:=xlValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
Next
End Sub



MfG,
coros
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 16 von hgbeifel

Hallo Coros,

ich danke dir, das Problem ist komplett gelöst. Für deine Geduld danke ich besonders. Nur wenn du jeden Laien so begleitest , kannst du dann noch anderen Aufgaben (Beruf ) nachgehen? ;-)

Viele Grüße
hgbeifel

Antwort 17 von kurt jürgen

Hallo Dank an alle hilfreichen Guten Geister im Supportnet und besonders Coros !!

Meine Tabelle entwickelt sich zum nun wirklich zu einem wirklich mehr als brauchbaren Werkzeug im täglichen Leben.
Eine Bitte hätte ich allerdings noch wenn es nicht zuviel verlangt ist.

Läßt sich die Tabelle in Querformat ausdrucken und habe ich die Möglichkeit nur bestimmte Spalten auszudrucken ?
( Meine Orginaltabelle ist für Querformat erstellt und beim jetzigen Audruck wird leider nur Hochformat ausgedruckt . )
Auch die Auswahl bestimmter Spalten würde mir echt helfen.

Nochmals Euch allen vielen Dank !!

Antwort 18 von coros

Moin Kurt Jürgens,

um das Blatt im Querformat auszudrucken musst Du es unter Seite einrichten..., zu finden in der Menüleiste unter Datei => Seite einrichten... und dann Registerkarte Papierformat, einstellen.

Damit Dir beim Drucken die Spalten, die Du nicht mitgedruckt haben möchtest, ausgeblendet werden, kopiere nachfolgendes Makro in ein StandardModul und weise es einer Schaltfläche zu.

Sub Drucken()
Application.ScreenUpdating = False
Range("B:B,D:D,E:E,G:G,J:J").EntireColumn.Hidden = True
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Range("B:B,D:D,E:E,G:G,J:J").EntireColumn.Hidden = False
End Sub


Wenn Du dieses Makro ausführst, werden zuerst die Spalten, die angegeben wurden, ausgeblendet, dann wird der Druckbefehl gesendet um das Blatt zu drucken und anschließend werden die Spalten, die ausgeblendet wurden,wieder eingeblendet. In diesem Makro werden die Spalten B, D, E, G und J ausgeblendet. Da Du sicherlich andere Spalten ausbelnden möchtest, musst Du in den Zeilen

Range("B:B,D:D,E:E,G:G,J:J").EntireColumn.Hidden = True

und

Range("B:B,D:D,E:E,G:G,J:J").EntireColumn.Hidden = False

die Spaltenbezeichnungen anpassen.

Ich hoffe, das hilft Dir weiter. Bei Fragen melde Dich.


MfG,
coros
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.

Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: