Tabellenkalkulation

Zellen Verbinden mit VBA wenn wert identisch

Diskussionsgruppen
Betriebsysteme: Windows 7; WindowsVista; WindowsXP; Linux; BS-Sonstige
Software: Textverarbeitung; Tabellenkalkulation; Datenbanken; Bildbearbeitung; Audio/mp3/Video; Security/Viren; E-Mail/Outlook; Internet Browser; SW-Sonstige
Hardware: Mainboard/CPU/RAM; Grafikkarten; Peripherie; HW Sonstiges
Netzwerk: DSL; W-Lan; Telekommunikation; NW-Sonstiges
Programmierung: Skripte(PHP,ASP,Perl...); Webseiten/HTML
Sonstiges: PC-Sonstiges; Plauderecke

Frage

Hallo Zusammen Ich suche eine Lösung um automatisch zellen zu Verbinden wenn der Wert mit der vorherigen oder mit der nächsten zelle identisch ist. Suchbereich: Zeile 10 Vielen Dank für eure rasche Antwort. Viele Grüsse David

Antwort 1 von Risatara2

Morgen...
Versuchs mal mit diesem VBA-Code:

Sub verbbindeZellen()
  Dim Spalte As Integer
  Const Maxspalte As Integer = 100
  
  Dim Arbeitsblatt As Worksheet
  
  For Spalte = 1 To Maxspalte
    Set Arbeitsblatt = ThisWorkbook.ActiveSheet
    With Arbeitsblatt
      If Cells(10, Spalte).Value = Cells(10, Spalte + 1).Value And Cells(10, Spalte).Value <> "" Then
        Cells(10, Spalte + 1).Value = ""
        Range(Cells(10, Spalte), Cells(10, Spalte + 1)).Merge
      End If
    End With
  Next Spalte
  
End Sub

Einfach in VBA einfügen und ausführen, geht allerdings nur bis 100 (kannst du mit der Konstante Maxspalte einstellen)

Gruß, Risatara

Antwort 2 von Lemming

Hallo Risatara

VIelen Dank. Funktioniert schon ziemlich gut, nur werden nun lediglich 2 Zellen miteinander verbunden.
Kann das scrip auch so angepasst werden, wenn in 4-8 zellen nacheinander der selbe wert steht und somit alle 4-8 zellen verbunden werden?

vienen dank.

gruss david

Antwort 3 von Risatara2

Moin moin,
OK, das is etwas härter, aber da hab ichs denn auch schon für dich.. Bei mir funktionierts, aber mach dir lieber vorher ne Sicherheitskopie.


Sub verbbindeZellen()
  Dim Spalte As Integer
  Dim Startspalte As Integer
  Dim Endspalte As Integer
  Dim Wert As Variant
  Dim X As Integer
  Const Maxspalte As Integer = 100

  Dim Arbeitsblatt As Worksheet
  
  Startspalte = 1
  Set Arbeitsblatt = ThisWorkbook.ActiveSheet
  With Arbeitsblatt
    For Spalte = 1 To Maxspalte
      If Cells(10, Spalte) <> Wert Then
        Endspalte = Spalte - 1
        If Startspalte < Endspalte Then
          For X = Startspalte + 1 To Endspalte
            Cells(10, X).Value = ""
          Next X
          Range(Cells(10, Startspalte), Cells(10, Endspalte)).Merge
        End If
        Startspalte = Spalte
        Wert = Cells(10, Spalte).Value
      End If
    Next Spalte
  End With

End Sub

Risatara

Antwort 4 von Lemming

Hallo Risatara

Das ist ja genial.
Wenn du noch eine optimierungen machen könntest dann bin ich mega happy:

die zeilen, welche den wert null haben soll er belassen.

vielen herzlichen dank.
david

Antwort 5 von Risatara2

LOOL, siehste, das war bei der ersten umstellung passiert :)

Antwort 6 von Risatara2

OK, hier der nächste Versuch:

Sub verbbindeZellen()
Dim Spalte As Integer
Dim Startspalte As Integer
Dim Endspalte As Integer
Dim Wert As Variant
Dim X As Integer
Const Maxspalte As Integer = 100
 
Dim Arbeitsblatt As Worksheet

Startspalte = 1
Set Arbeitsblatt = ThisWorkbook.ActiveSheet
With Arbeitsblatt
For Spalte = 1 To Maxspalte
If Cells(10, Spalte) <> Wert Then
Endspalte = Spalte - 1
If Startspalte < Endspalte And Wert <> "" Then
For X = Startspalte + 1 To Endspalte
Cells(10, X).Value = ""
Next X
Range(Cells(10, Startspalte), Cells(10, Endspalte)).Merge
End If
Startspalte = Spalte
Wert = Cells(10, Spalte).Value
End If
Next Spalte
End With

End Sub

Antwort 7 von Lemming

Perfekt. Vielen herzlichen Dank.

Liebe Grüsse und bald einen guten rutsch ins neue jahr :-)

David

Antwort 8 von Risatara2

Danke gleichfalls und danke für rückmeldung