Hallo Profis und alle die Ahnung haben
Ich habe auf einem Tabellenblatt 4 Tabellen nebeneinander mit je 3 Spalten und rund 50 Zeilen. Die ersten Spalten jeder Tabelle habe ich zu einem Bereich zusammengefasst und kann dort mit einem Doppelklick ein x einfügen. Ich möchte jetzt diesen Bereich(alle 4 Tabellen) per Button nach x absuchen. Wird ein x gefunden sollen die Werte der zweiten und dritten Spalte hinter dem x, in eine zweispaltige Tabelle auf dem Tabellenblatt2 gespeichert werden. Beginn dieser Tabelle sollte ungefähr D10 sein. Der Vorgang soll sich wiederholen bis kein x mehr gefunden wird.
Schon mal vielen Dank
Es grüßt Sagulum
Hi,
du solltest uns deine Tabelle zeigen (kein Bildchen!!!). Lade sie bitte hier hoch (wie es geht, steht hier:
http://www.clever-excel-forum.de/thread-326.html), denn deine Infos sind - zumindest für mich - für eine adäquate Hilfe zu dürftig. Falls du sensible Daten in deiner Mappe hast, solltst du sie unbedingt anonymisieren.
War wohl ein wenig knapp
Lade die Datei hoch. Ich will Datensätze zusammenstellen um sie auf einer Faxvorlage ausdrucken zu können. Ach ja auf jedes Fax passen nur rund 25 Datensätze. Es müssten bei Bedarf automatisch zwei Tabellen gefüllt werden.
Es grüßt Sagulum
Hier ist noch mal das Sagulum
Hier jetzt im Anhang, das Aussehen, wie ich mir das Projekt vorstelle.
Es grüßt Sagulum
Hallöchen,
Die einfachste, wenngleich nicht besonders professionelle Variante wäre, die Zeilen alle einzeln durchzugehen und wenn ein x gefunden wird, diese zu übertragen.
Man könnte 2 verschachtelte Schleifen programmieren, die das tun
Im Prinzip so, mal fix hier notiert:
Code:
Sub Uebertragen
'Variablendeklaration
Dim iCnt1%, iCnt2%, iColFax%, iRowFax%
'Schleife ueber alle Bereiche
For iCnt=2 to 14 step 4
'Schleife ueber alle Zeilen
For iCnt2 = 7 to 56
'Wenn Zelle in erster Spalte des Bereiches ein x enthaelt, denn
If Cells(iCnt2,iCnt1).Value="x" Then
'Daten auf Fax-Seite uebertragen
'erste freie Fax-Zeile ermitteln
iRowFax=Sheets("Fax-Daten").Cells(Rows.count,5).end(xlup).Row+1
'bei erstem Eintrag in Zeile 27 wechseln
If iRowFax < 27 Then iRowFax=27
'Wenn Zeile 55 erreicht ist, dann Wechsel in Zweiten Bereich, Zeile 27
If iRowFax = 55 Then iRowFax=27:iColFax=30
'erste zelle uebertragen
Sheets("Fax-Daten").Cells(irowFax,iColFax).Value=Cells(iCnt2,iCnt1+1).Value
'zweite zelle uebertragen
Sheets("Fax-Daten").Cells(irowFax,iColFax).Value=Cells(iCnt2,iCnt1+2).Value
'Ende Schleife ueber alle Zeilen
Next
'Ende Schleife ueber alle Bereiche
Next
End Sub
Hallo Schauan
Erst mal vielen Dank, das du dich mit meinem Problem beschäftigt hast. Bin gerade von der Arbeit gekommen und zu müde um mich mit deinem Vorschlag zu befassen. Ich Melde mich bald wieder.
Viele Grüße Sagulum :28:
Hallöchen,
ich habe den Code jetzt noch getestet und Fehler korrigiert.
Wenn Du den Code startest, musst Du auf der Daten-Seite sein. Aber da der Button zum Übertragen dort ist, gehe ich davon aus, dass das auch so sein wird.
Code:
Sub Uebertragen()
'Variablendeklaration
Dim iCnt1%, iCnt2%, iColFax%, iRowFax%
'erste Spalte auf Blatt Fax-Seite setzen
iColFax = 5
'Schleife ueber alle Bereiche
For iCnt1 = 2 To 14 Step 4
'Schleife ueber alle Zeilen
For iCnt2 = 7 To 56
'Wenn Zelle in erster Spalte des Bereiches ein x enthaelt, denn
If Cells(iCnt2, iCnt1).Value = "x" Then
'Daten auf Fax-Seite uebertragen
'erste freie Fax-Zeile ermitteln
iRowFax = Sheets("Fax-Seite").Cells(Rows.Count, 5).End(xlUp).Row + 1
'bei erstem Eintrag in Zeile 27 wechseln
If iRowFax < 27 Then iRowFax = 27
'Wenn Zeile 55 erreicht ist, dann Wechsel in Zweiten Bereich, Zeile 27
If iRowFax = 55 Then iRowFax = 27: iColFax = 30
'erste zelle uebertragen
Sheets("Fax-Seite").Cells(iRowFax, iColFax).Value = Cells(iCnt2, iCnt1 + 1).Value
'zweite zelle uebertragen
Sheets("Fax-Seite").Cells(iRowFax, iColFax + 7).Value = Cells(iCnt2, iCnt1 + 2).Value
'Ende Wenn Zelle in erster Spalte des Bereiches ein x enthaelt, denn
End If
'Ende Schleife ueber alle Zeilen
Next
'Ende Schleife ueber alle Bereiche
Next
'Fertigmeldung
MsgBox "Fertig!"
End Sub
Hallo Schuan
Vielen Dank für deine Hilfe. Bis jetzt klappt es prima. Wenn sich dein Code auch in der Praxis bewährt, werden meine Kollegen und ich es in Zukunft wesentlich leichter haben.
Also noch mal vielen Dank vom Sagulum :28: :97: :98:
Hallo Schauan und alle die Interesse haben
Ich hab an dem Projekt noch ein wenig rumgebastelt und jetzt klappt es nicht mehr wie es soll. Um eine bessere Übersicht zu bekommen, wollte ich auf dem Fax Leerzeilen einfügen. Um variabel zu bleiben, wird bei Doppelklick in die ersten Spalten nicht nur ein x eingefügt, es wird auch geprüft ob die Zelle rechts daneben leer ist --> wenn ja kommt da auch ein x rein. nach dem Übertragen aufs Fax werden die kleinen x wieder entfernt. Im Code habe ich das ans ende von Uebertragen reingebastelt.
Jetzt wird aber nur noch das erste Fax gefüllt. Habs aber jetzt erst mit so viel Daten getestet, dass bei einem Durchgang beide Faxe benötigt werden. Vorher habe ich mit weniger Daten einfach mehrfach auf Übertragen geklickt. Da ging es. Im Anhang der aktuelle Stand der Datei.
Ich hoffe es gibt eine Lösung.
Viele Grüße Sagulum :s
Hallo Excelfreunde
Habe es gelöst indem ich nur eine Fax-Vorlage verwende und auf der Daten-Seite einen Zähler eingebaut habe.
Viele grüße Sagulum