Microsoft Excel

Herbers Excel/VBA-Archiv

Zellen per Makro verbinden

Betrifft: Zellen per Makro verbinden von: Marcus Kempf
Geschrieben am: 23.10.2014 10:16:14

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.

  

Betrifft: AW: Zellen per Makro verbinden von: Rudi Maintaire
Geschrieben am: 23.10.2014 11:02:55

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


  

Betrifft: AW: Zellen per Makro verbinden von: Marcus Kempf
Geschrieben am: 23.10.2014 11:18:23

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?


  

Betrifft: AW: Zellen per Makro verbinden von: Marcus Kempf
Geschrieben am: 23.10.2014 11:46:20

Also das Ganze soll erst für Januar durchlaufen, dann für Februar.....


  

Betrifft: AW: Zellen per Makro verbinden von: Marcus Kempf
Geschrieben am: 23.10.2014 11:47:44

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



  

Betrifft: AW: Beispieldatei ? von: Daniel
Geschrieben am: 23.10.2014 12:48:12

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


  

Betrifft: AW: Beispieldatei ? von: Marcus Kempf
Geschrieben am: 23.10.2014 12:54:47

Hier ist die Datei zu finden.

https://www.herber.de/bbs/user/93308.xlsx

Ich möchte über da Makro das Problem der Schaltjahre lösen.


  

Betrifft: AW: Beispieldatei ? von: Daniel
Geschrieben am: 23.10.2014 17:32:14

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


  

Betrifft: hier eine Variante von: Tino
Geschrieben am: 23.10.2014 17:43:39

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


  

Betrifft: AW: hier eine Variante von: Marcus Kempf
Geschrieben am: 23.10.2014 18:10:20

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


  

Betrifft: AW: hier eine Variante von: Marcus Kempf
Geschrieben am: 23.10.2014 18:17:34

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. :-(


  

Betrifft: AW: hier eine Variante von: Tino
Geschrieben am: 23.10.2014 18:50:24

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


  

Betrifft: AW: hier eine Variante von: Marcus Kempf
Geschrieben am: 23.10.2014 19:12:06

Tino,

Unglaublich, ich danke Dir :-)


  

Betrifft: hier für zweite Frage von: Tino
Geschrieben am: 23.10.2014 21:03:15

Hallo,
kannst mal versuchen.

https://www.herber.de/bbs/user/93325.xlsm

Gruß Tino


  

Betrifft: AW: hier für zweite Frage von: Marcus Kempf
Geschrieben am: 24.10.2014 10:15:28

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


  

Betrifft: AW: hier für zweite Frage von: Marcus Kempf
Geschrieben am: 24.10.2014 10:45:55

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.


  

Betrifft: AW: hier für zweite Frage von: Marcus Kempf
Geschrieben am: 24.10.2014 13:23:48

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 :-(


  

Betrifft: AW: hier für zweite Frage von: Tino
Geschrieben am: 24.10.2014 13:57:00

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


  

Betrifft: AW: hier für zweite Frage von: Marcus Kempf
Geschrieben am: 24.10.2014 14:42:13

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.


  

Betrifft: AW: hier für zweite Frage von: Tino
Geschrieben am: 24.10.2014 15:32:34

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


  

Betrifft: Am Geschicktesten ggf ... von: Luc:-?
Geschrieben am: 23.10.2014 16:51:56

…mit diesem Tool, Marcus…
Gruß, Luc :-?


 

Beiträge aus den Excel-Beispielen zum Thema "Zellen per Makro verbinden"