Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Spalte nach "X" absuchen und 3 Zellen kopieren

Spalte nach "X" absuchen und 3 Zellen kopieren
15.08.2016 18:09:35
Pflaume
Hallo zusammen. Ich habe ein Problem und hoffe, dass mir hier jemand weiterhelfen kann. Ich habe eine Excel-Datei, bestehend aus 2 Seiten. Auf der 2. Seite (heißt bei mir "Unterweisung") habe ich mein Leerformular, welches es mittels Makro zu befallen gibt. Außerdem wähle ich hier mittels Drop-Down-Liste meine Namens-, bzw. Schichtgruppe in Zelle D4 aus (SG_A, B, C, D). Auf Seite 1 (bei mir "Übersicht") sind die 4 Schichtgruppen nebeneinander aufgelistet. Wähle ich auf Seite 2 z.B. SG_A, soll Spalte G auf Seite 1 nach "X" durchsucht werden. Von jeder Zeile ab Zeile 7 mit einem "X" in Spalte G sollen die Zellen C=Vorname, D=Nachname und E=Stammnummer kopiert und untereinander auf Seite 2 in das Leerformular kopiert werden. Der erste Vorname würde dann auf Seite 2 ("Unterweisung") in Zelle G14 stehen, der erste Nachname in Zelle H14 und die erste Stammnummer in Zelle I14.
Ziel ist es, das Drucken von Unterweisung zu vereinfachen. Man wählt seine Schichtgruppe und die zu unterweisenden Mitarbeiter aus, betätigt das Makro mittels Button, welches im Anschluss einen Druckbefehl sendet. Den Befehl zum Drucken habe ich bereits. Da mein PC zuhause den Geist aufgegeben hat und ich in der Arbeit keinen Internetzugriff habe, versuche ich es so gut wie möglich zu erklären. Einen Ausdruck meiner Mappe habe ich vor mir, die Zellen stimmen also aber jetzt weiter zu Part 2. Wichtiger ist aber der obere Teil. Für den Rest könnte ich das Makro für die anderen 3 Schichtgruppen etvl selbst umwandeln.
Die Spalten für SG_B (selbe Zeile wie SG_A) sind J,K und L (und N für "X") - SG_C sind Q, R und S (und U für "X") und SG_D sind X, Y und Z (und AB für "X"). Das wäre aber erst mal nicht so wichtig und würde ich selbst evtl auch noch hinbekommen. Das Wichtige wäre der obere Part und ich hoffe, dass mir jemand helfen kann. Wünsche noch einen schönen Montag.
Gruß Pflaume

18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Folgethread - Internet - Beispieldatei?
15.08.2016 18:44:11
Michael
Hi Pflaume,
von welchem Rechner aus schreibst Du dann Deine Posts? Hat der keinen Anschluß für einen USB-Stick?
Es ist ja schön, daß Du "einen Ausdruck der Mappe vor Dir hast", wir haben den aber nicht.
Also, sieh bitte zu, daß Du ne Datei hochladen kannst.
Schöne Grüße,
Michael
P.S.: einige Antworten unter https://www.herber.de/forum/messages/1509106.html
AW: Folgethread - Internet - Beispieldatei?
15.08.2016 19:29:33
Pflaume
Ich schreibe von meinem iPhone :)
AW: Folgethread - Internet - Beispieldatei?
15.08.2016 19:36:44
Pflaume
Ich schreibe von meinem iPhone :)
AW: Folgethread - Internet - Beispieldatei?
15.08.2016 21:45:37
Werner
Hallo Pflaume,
ich hab mal die Blätter nach deiner Beschreibung nachgebaut. Datei ist im Anhang. Folgendes Makro habe ich geschrieben:
Sub Schaltfläche3_Klicken()
Dim Spalte As Long
Dim loLetzte As Long
Dim loLetzte1 As Long
Select Case Sheets("Unterweisung").Range("D4").Value
Case "A": Spalte = 3
Case "B": Spalte = 10
Case "C": Spalte = 17
Case "D": Spalte = 24
Case Else
End Select
loLetzte = Sheets("Übersicht").Cells(Rows.Count, Spalte).End(xlUp).Row
loLetzte1 = Sheets("Unterweisung").Cells(Rows.Count, 7).End(xlUp).Row + 1
Application.ScreenUpdating = False
With Sheets("Übersicht")
Set bereich = .Range(.Cells(6, Spalte), .Cells(loLetzte, Spalte + 4))
.Range(bereich.Address).AutoFilter Field:=5, Criteria1:="x"
.Range(.Cells(65536, Spalte), .Cells(7, Spalte + 2)).SpecialCells(xlCellTypeVisible).Copy _
Sheets("Unterweisung").Cells(loLetzte1, 7)
If .FilterMode Then
.ShowAllData
.AutoFilterMode = False
End If
End With
Application.ScreenUpdating = True
End Sub
https://www.herber.de/bbs/user/107637.xlsm
Gruß Werner
Anzeige
AW: Folgethread - Internet - Beispieldatei?
16.08.2016 05:09:31
Pflaume
Vielen Dank schon mal. In meiner Liste werden immer folgende Zeilen gelb markiert: .Range(.Cells(65536, Spalte), .Cells(7, Spalte + 2)).SpecialCells(xlCellTypeVisible).Copy _
Sheets("Unterweisung").Cells(loLetzte1, 7)
Der Rest scheint schon so weit zu passen aber bei diesem Teil gefällt ihm irgendwas nicht. Hast du eine Ahnung, was das sein könnte? Vielen Dank für deine Hilfe. Das ist wirklich wahnsinnig nett.
Gruß Pflaume
AW: Folgethread - Internet - Beispieldatei?
16.08.2016 07:48:36
Werner
Hallo,
welche Fehlermeldung? Aber ohne eine hochgeladene Datei wird es dann wohl eher nichts. In meiner Testdatei hat es fehlerfrei funktioniert.
Gruß Werner
Anzeige
AW: Folgethread - Internet - Beispieldatei?
16.08.2016 14:06:09
Pflaume
Alles klar, ich werde versuchen, irgendwie ranzukommen. Vielen Dank
AW: Folgethread - Internet - Beispieldatei?
17.08.2016 07:06:14
Pflaume
Hallo Werner. Hat ein bisschen gedauert aber über ein paar Umwege konnte ich die Datei kopieren. Wäre sehr sehr nett von dir, wenn du dir das noch einmal ansehen und mir sagen könntest, was ich falsch gemacht habe. Dein Makro ist auf dem Button. Vielen Dank im Voraus.
Gruß Pflaume
https://www.herber.de/bbs/user/107660.xlsm
AW: Folgethread - Internet - Beispieldatei?
17.08.2016 10:25:02
Werner
Hallo,
Excel spricht doch mit dir. Es hat dir in der Fehlermeldung gesagt, dass es an verbundenen Zellen liegt.
Du hast im Blatt "Sammelunterweisung" in Zeile 58 verbundene Zellen und damit hat der Code seine Probleme.
Lösung: Hebe den Zellverbund auf. Die gleiche Optik erhälst du wenn du anschließend alle Zellen die du vorher verbunden hattest markierst, anschließend Rechtsklick in den markierten Bereich, Zellen formatieren, Ausrichtung, und bei Horizontal "Über Auswahl zentrieren"
Danach läuft das Makro.
Ich habe noch ein paar kleine Änderungen gemacht, weil er dir sonst beim Kopieren die Formatierungen vom Blatt "Band" ins Blatt "Sammelunterweisung" übernommen hätte. Jetzt kopiert er nur die Werte.
Da ich nicht weiß, ob du zwischenzeitlich wieder Online bist schicke ich dir mal sowohl das geänderte Makro als auch deine angepasste Datei.
Sub Schaltfläche7_Klicken()
Dim Spalte As Long
Dim loLetzte As Long
Dim loLetzte1 As Long
Select Case Sheets("Sammelunterweisung").Range("D4").Value
Case "SG_A": Spalte = 3
Case "SG_B": Spalte = 10
Case "SG_C": Spalte = 17
Case "SG_D": Spalte = 24
Case Else
End Select
loLetzte = Sheets("Band").Cells(Rows.Count, Spalte).End(xlUp).Row
loLetzte1 = Sheets("Sammelunterweisung").Cells(Rows.Count, 7).End(xlUp).Row + 1
Application.ScreenUpdating = False
With Sheets("Band")
Set bereich = .Range(.Cells(6, Spalte), .Cells(loLetzte, Spalte + 4))
.Range(bereich.Address).AutoFilter Field:=5, Criteria1:="x"
.Range(.Cells(65536, Spalte), .Cells(7, Spalte + 2)).SpecialCells(xlCellTypeVisible).Copy
Sheets("Sammelunterweisung").Cells(loLetzte1, 7).PasteSpecial Paste:=xlPasteValues
Sheets("Sammelunterweisung").Range("G14").Select
Application.CutCopyMode = False
If .FilterMode Then
.ShowAllData
.AutoFilterMode = False
End If
End With
Application.ScreenUpdating = True
End Sub
https://www.herber.de/bbs/user/107665.xlsm
Gruß Werner
Anzeige
AW: Folgethread - Internet - Beispieldatei?
17.08.2016 15:59:27
Pflaume
Oh man... Die verbundenen Zellen... Und wir zerbrechen uns 2 Tage lang den Kopf :) Naja, man lernt die aus. Werner, vielen herzlichen Dank für deine ausführliche Hilfe und deine Geduld. Das ist sehr nett von dir. Es klappt wunderbar. Wie gewünscht! Ich wünsche dir einen schönen Tag.
Gruß Pflaume
AW: Gerne u. Danke für die Rückmeldung. o.w.T
17.08.2016 17:06:30
Werner
AW: Gerne u. Danke für die Rückmeldung. o.w.T
18.08.2016 20:35:24
Pflaume
Hallo Werner. Dürfte ich noch einmal deine Hilfe in Anspruch nehmen. Betrifft die 1. Seite dieser Mappe. Ich möchte über die Zelle G4:G6 für SG_A über eine Drop-Down-Liste mit einem weiteren X die Auswahl für alle in der Liste vorhandenen Mitarbeiter setzen. Abhängig davon, wieviel MItarbeiter überhaupt in der Liste stehen. Quasi mit diesem X alle X in der Spalte G aktivieren wenn ein Mitarbeiter in der Zeile steht! Könntest du mir da noch einmal helfen? Gruß Pflaume
Anzeige
AW: Gerne u. Danke für die Rückmeldung. o.w.T
18.08.2016 21:07:29
Werner
Hallo,
da hast du aber Glück, dass ich hier nochmal reinschaue - war ja eigentlich erledigt.
Wenn ich dich richtig verstanden habe dann für jede Schichtgruppe ein Pulldown mit dem du die x für alle gelisteten Mitarbeiter der jeweiligen Schichtgruppe auf einmal setzen kannst.
Sollte kein Problem sein. Aber heute nicht mehr. Schau ich mir morgen mal an.
Gruß Werner
AW: Gerne u. Danke für die Rückmeldung. o.w.T
18.08.2016 21:10:15
Pflaume
Ganz genau. Super, vielen lieben Dank!
AW: Gerne u. Danke für die Rückmeldung. o.w.T
19.08.2016 06:20:47
Pflaume
Ganz genau. Super, vielen lieben Dank!
AW: Gerne u. Danke für die Rückmeldung. o.w.T
19.08.2016 11:18:22
Werner
Hallo,
ich stell dir den Code (gehört ins CodeModul des Blattes "Band") sowie die Datei hier rein.
Wichtig: Du hattest/hast in den Bereichen G4:G6 / N4:N6 / U4:U6 / AB4:AB6 verbundene Zellen. Unbedingt den Zellverbund wieder aufheben. In der hochgeladenen Datei habe ich das schon gemacht.
Pulldowns sind/gehören in den Zellen G4 / N4 / U4 / AB4
Als Auswahl in den Pulldowns ein x bzw. ein leer
Bei Auswahl von x werden alle Mitarbeiter der entsprechenden Schichtgruppe mit einem x markiert. Bei Auswahl des Leerfeldes werden die x bei allen Mitarbeitern der entsprechenden Schichtgruppe entfernt.
Das kannst du auch verwenden um alle händisch gesetzten x wieder zu entfernen - einfach im Pulldown das Leerfeld auswählen.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim loLetzte As Long
Dim Spalte As Long
Dim Bereich As Range
Dim Zelle As Range
If Target.Address(0, 0) = "G4" Or Target.Address(0, 0) = "N4" _
Or Target.Address(0, 0) = "U4" Or Target.Address(0, 0) = "AB4" Then
Select Case Target.Address
Case "$G$4": Spalte = 7
Case "$N$4": Spalte = 14
Case "$U$4": Spalte = 21
Case "$AB$4": Spalte = 28
Case Else
End Select
If Target.Row = 4 And Target.Column = Spalte Then
loLetzte = Cells(Rows.Count, Spalte - 4).End(xlUp).Row
If Target.Value = "x" Then
Set Bereich = Range(Cells(7, Spalte), Cells(loLetzte, Spalte))
For Each Zelle In Bereich
Zelle.Value = "x"
Next Zelle
ElseIf Target.Value = "" Then
loLetzte = Cells(Rows.Count, Spalte).End(xlUp).Row
Set Bereich = Range(Cells(7, Spalte), Cells(loLetzte, Spalte))
For Each Zelle In Bereich
Zelle.ClearContents
Next Zelle
End If
End If
End If
End Sub
https://www.herber.de/bbs/user/107713.xlsm
Gruß Werner
Anzeige
AW: Gerne u. Danke für die Rückmeldung. o.w.T
19.08.2016 19:13:59
Pflaume
Du bist der Wahnsinn. Dieses Forum ist einfach top. Du kennst mich nicht einmal und nimmst dir hier ständig für mich Zeit. Ohne deine Hilfe wäre ich noch ganz am Anfang von meinem Vorhaben. Vielen vielen Dank. Klappt wieder einmal wunderbar. Jetzt kann ich diesen Teil des Projekts abschließen und entspannt ins Wochenende gehen. Dir auch ein schönes Wochenende. Beste Grüße, Pflaume
AW: Freut mich, dass ich helfen konnte.
19.08.2016 22:02:28
Werner
Hallo,
über den Versuch hier zu helfen will ich mich in Sachen Excel und VBA verbessern. Würde sagen, dass ich gerade erst über den Anfängerstatus raus bin. Macht mir einfach Spaß.
Und das mit dem schönen Wochenende - na ja, muss arbeiten. Trotzdem Danke.
Gruß Werner
Anzeige

325 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige