Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1388to1392
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
Inhaltsverzeichnis

Zellen per Makro verbinden

Zellen per Makro verbinden
23.10.2014 10:16:14
Marcus
Hallo,
ich beschäftige mich nun schon einige Zeit mit dem Bereich VBA und bin echt von den Möglichkeiten beeindruckt.
Nun stecke ich jedoch etwas fest.
Ich möchte gerne Zellen per Makro miteinander verbinden.
Dies soll unter folgenden Gesichtpunkten geschehen:
Wenn in Zelle A1 z.B. Januar steht, sollen ab Zelle A2 alle Zellen verbunden werden, bis nicht mehr Januar in Ihnen steht.
Wie kann dies am geschicktesten realisiert werden?
Danke im Voraus für euere Hilfe.

20
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zellen per Makro verbinden
23.10.2014 11:02:55
Rudi
Hallo,
als Ansatz:
Sub aa()
Dim r As Range
Set r = Range("A1")
Do While r.Offset(1) = r
Set r = r.Offset(1)
Loop
Application.DisplayAlerts = False
Range(Range("A2"), r).Merge
Application.DisplayAlerts = True
End Sub

Gruß
Rudi

AW: Zellen per Makro verbinden
23.10.2014 11:18:23
Marcus
Wurde soweit verstanden.
das ganze kann ich ja beliebige mal hintereinander laufen lassen.
Ich muss jedoch immer die neue "Startzelle" kennen, wie kann ich diese automatisch vergeben lassen?

AW: Zellen per Makro verbinden
23.10.2014 11:46:20
Marcus
Also das Ganze soll erst für Januar durchlaufen, dann für Februar.....

Anzeige
AW: Zellen per Makro verbinden
23.10.2014 11:47:44
Marcus
Verzeihung für die Mehrfachposts, aber ich finde keine Möglichkeit die Beiträge zu bearbeiten.
So gibt er mir auf jeden Fall eine Typenunverträglichkeit aus.
Sub aa()
Dim r As Range
Dim r2 As Range
Set r = Range("A1")
Do While r.Offset(1) = r
Set r = r.Offset(1)
Loop
Set r2 = r.Offset(1)
Application.DisplayAlerts = False
Range(Range("A2"), r).Merge
Application.DisplayAlerts = True
Do While r2.Offset(1) = r2
Set r2 = r2.Offset(1)
strActiveCell = ActiveCell.Address
Loop
Application.DisplayAlerts = False
Range(Range(r2 + 1), r).Merge
Application.DisplayAlerts = True
End Sub

Anzeige
AW: Beispieldatei ?
23.10.2014 12:48:12
Daniel
Hi
lade doch einfach mal deine Datei hoch.
auf dem ersten Blatt sollest du zeigen, wie die Daten vorliegen und auf dem zweiten Blatt, wie du dir das Ergebnis vorstellst, von Hand erstellst.
Dann wird klarer was du willst und brauchst und man kann seinen Code schon mal testen.
Gruß Daniel

AW: Beispieldatei ?
23.10.2014 17:32:14
Daniel
Hi
anbei zwei Codes, die dir die Zuammenfassung der Zellen erledigt.
der erste Code sind klassisch verbundene Zellen (so wie wenn du die Zellen markierst und verbindest).
Hierbei werden die Inhalte der Verbundenen Zellen gelöscht, ausser in der ersten Zelle des Verbundes.
das hat nachteile, weil es jetzt nicht mehr möglich ist, die Tabelle zu filtern oder mit Formeln nach dem Monat auszuwerten.
der zweite Code verwendet eine andere Methode den Zellverbund zu erstellen.
hierbei wird in einem leeren Zellbereich ein gleich grosser Zellverbund mit leeren zellen gebildet und dann wird von diesem Zellverbund das Format auf die eigentlichen Zellen übertragen.
Dabei werden diese Zellen dann auch verbunden, aber ihr eigentlicher Inhalt bleibt erhalten, so dass man diese Spalte weiterhin für den Autofilter oder Sortierungen verwenden kann und das trotz verbundener Zellen:
Option Explicit
Sub Umformen1()
Dim Zelle1 As Range
Dim Zelle2 As Range
Set Zelle1 = Cells(3, 1)
Do While Zelle1.Value  ""
Set Zelle2 = Columns(1).Find(what:=Zelle1.Value, _
LookIn:=xlValues, _
lookat:=xlWhole, _
searchdirection:=xlPrevious)
Range(Zelle1.Offset(2, 0), Zelle2).ClearContents
With Range(Zelle1.Offset(1, 0), Zelle2)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Orientation = xlVertical
.MergeCells = True
End With
Set Zelle1 = Zelle2.Offset(1, 0)
Loop
End Sub
Sub Umformen2()
Dim sp As Long
Dim Zelle1 As Range
Dim Zelle2 As Range
sp = ActiveSheet.UsedRange.Columns.Count + 1
Set Zelle1 = Cells(3, 1)
Do While Zelle1.Value  ""
Set Zelle2 = Columns(1).Find(what:=Zelle1.Value, _
LookIn:=xlValues, _
lookat:=xlWhole, _
searchdirection:=xlPrevious)
With Range(Zelle1.Offset(1, 0), Zelle2)
With .Offset(0, sp)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Orientation = xlVertical
.MergeCells = True
.Copy
End With
.PasteSpecial xlPasteFormats
.Offset(0, sp).MergeCells = False
.Offset(0, sp).ClearFormats
End With
Set Zelle1 = Zelle2.Offset(1, 0)
Loop
End Sub
Gruß Daniel

Anzeige
hier eine Variante
23.10.2014 17:43:39
Tino
Hallo,
hier mal eine Variante, Kommentare stehen im Code.
Datei muss als xlsm o. xls o. xlsb gespeichert werden, xlsx kann kein VBA
https://www.herber.de/bbs/user/93322.xlsm
Gruß Tino

AW: hier eine Variante
23.10.2014 18:10:20
Marcus
Hallo Tino,
das ist ja schon des Rätsels Lsung :-) Ganz herzlichen Dank.
Besteht eventuell auch noch die Möglichkeit die erstellten Zellverbünde über:

Rows("4:33").Select
Range("B4").Activate
Selection.Rows.Group
gleich noch zu Gruppieren?
Das I-Tüpfelchen wäre noch eine Abwechselnde Einfärbung in Wunschfarbe.
Vielen lieben Dank im Voraus für deine Mühe.
Gruß Marcus

Anzeige
AW: hier eine Variante
23.10.2014 18:17:34
Marcus
Hallo Tino,
folgendes ist mir gerade noch in den Sinn gekommen.
Ganz zum Anfang ertslle ich die "Ursprungsversion" in meiner Datei mit dem Befehl

A3=TEXT(B3;"MMMM")
Dies müsste ja eigentlich zuerst erfolgen, damit die Verbindung und Gruppierung nach einem Jahreswechsel korrekt ausgeführt werden kann.
Wenn ich jedoch versuche die Formel in das VBA-Script zu integrieren, bekomme ich die Meldung des falschen Listenzeichens. :-(

AW: hier eine Variante
23.10.2014 18:50:24
Tino
Hallo,
kannst mal testen
Fürs zweite habe ich jetzt keine Zeit mehr, evtl. später.
https://www.herber.de/bbs/user/93324.xlsm
Gruß Tino

Anzeige
AW: hier eine Variante
23.10.2014 19:12:06
Marcus
Tino,
Unglaublich, ich danke Dir :-)

AW: hier für zweite Frage
24.10.2014 10:15:28
Marcus
Hallo Tino,
das klappt soweit wunderbar, jedoch habe ich eine Tatsache in meiner Vorlage vergessen zu berücksichtigen.
In der eigentlichen Datei beginne ich bereits mit dem 18.12. des Vorjahres. das klappt dann nicht, da die Erfassungsweite wohl genau auf ein Jahr begrenzt ist.
Ich habe die Originaldatei an der ich gerade arbeite mal anonymisiert angehängt.
Vielleicht kannst Du für mich auch noch einen kurzen Blick auf die Formel in Zelle C26 werfen?
Ich bin dort absolut ratlos, warum sie nicht funktioniert.
Ziel des Ganzen ist, dass ich an einem Brückentag "BT" in Spalte C steht, wodurch Gültigkeitsliste"BT" aktiviert wird. (Hier habe ich leider noch nicht rausbekommen, wie der einzige Wert "1" direkt beim anwählen der Liste aktiviert werden kann.
An einem Feiertag soll "FT" in Spalte C stehen und wie mit BT allerdings ohne automatisches Auswählen verfahren werden.
https://www.herber.de/bbs/user/93334.xlsm
Danke für deine großartige Hilfe.
Marcus

Anzeige
AW: hier für zweite Frage
24.10.2014 10:45:55
Marcus
Also, wie es meist so ist, habe ich zumindest das korrekte anzeigen von BT und FT über folgende Formel hin bekommen:

=WENN(ODER(IDENTISCH($B26;$H$5:$I$8));"BT";WENN(ODER(IDENTISCH($B26;$C$5:$C$15));"FT";TEXT(B26;" _
TTT"&".")))
Bliebe nur noch zu klären, wie denn bei "BT" die 1 direkt angezeigt werden kann.

AW: hier für zweite Frage
24.10.2014 13:23:48
Marcus
Hier mal noch mein Lösungsansatz für das Lösen des Automatischen Füllens mit Einsen.

Sub BT()
Dim i As Integer
Dim j As String
For i = 26 To 418
If Range.["B"i].Value = "BT" Then
For j = E To CZ
If Range.[j20].Value  "" Then
Range.[ji].Value = "1"
End If
End If
End Sub
Jedoch nicht von Erfolg gekrönt :-(

Anzeige
AW: hier für zweite Frage
24.10.2014 13:57:00
Tino
Hallo,
habe den Code umgeschrieben und die Formel angepasst.
Das mit der 1 habe ich nicht verstanden!
Evtl. mit der Formel =Wenn($B26="BT";1;"")
https://www.herber.de/bbs/user/93338.xlsm
Gruß Tino

AW: hier für zweite Frage
24.10.2014 14:42:13
Marcus
Hallo Tino,
das klappt wunderbar, danke dafür.
Aus irgendeinem Grund funktioniert jedoch die bedingte formatierung für die Wochenenden nicht mehr, kannst Du Dir dies erklären?
Ich habe versucht meinen Wunsch bezüglich der eins mal in einen VBA-Code umzusetzen, bin leider jedoch gescheitert, aber vielleicht hilft es ja beim Verstädnis, was ich erreichen möchte:

Private Sub BT()
Dim Zeile As Integer
Dim j As Integer
Zeile = 1
Do
If "BT" = Cells(k, 1).Value Then
For j = 5 To 73
If Cells(j, 20).Value  "" Then
Cells(j, Zeile).Value = "1"
Next
End If
Zeile = Zeile + 1
Loop While Cells(Zeile, 1).Value  ""
End Sub
Wenn in Spalte C ein BT steht, sollen die nachfolgenden Mitarbeiterzellen automatisch mit einer 1 gefüllt werden, wenn über $E20 ein Mitarbeiter angelgt wurde.
Mit einer Wenn Funktion klappt es nicht, da diese ja durch eine Auswahl der sonst (wenn kein BT in Spalte C steht) vorhandenen Dropdownliste überschrieben würde.

Anzeige
AW: hier für zweite Frage
24.10.2014 15:32:34
Tino
Hallo,
ändere das Format in der Formel in der Spalte C
nach aus
TEXT(B26;" _
TTT"&".")

TEXT(B26;"TTT.")
Schau mal ob es so geht.
https://www.herber.de/bbs/user/93345.xlsm
Gruß Tino

Am Geschicktesten ggf ...
23.10.2014 16:51:56
Luc:-?
…mit diesem Tool, Marcus…
Gruß, Luc :-?

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige