Zellen verbinden wenn gleiche nebeneinander

[Daniel.Fr...@gmx.de]

Hallo,

Ich suche eine möglichkeit automatisch (Makro?); Excelzellen die
nebeneinander liegen zu verbinden, wenn sie denn gleichen Inhalt haben.

Erklärung:

Ich habe einen Jahresplan, indem aufgelistet ist wo die Personen in den
entsprechenden Kalenderwochen waren. Wenn nun die Person XY, drei Wochen
hintereinander in der selben Abteilung XY war steht 3 mal XY in den
Zellen.
Nun muß ich manuell diesen Zellen eine grosse schaffen (verbinden).

Gibt es eine möglichkeit Excel die Zelle auslesen und sie bei Gleichheit
zuverbinden?

Vielen Dank im Vorraus........und einen schönene Tag noch.

Mit freundlichen Grüssen

Daniel Frensemeier

Sent via Deja.com http://www.deja.com/
Before you buy.

[Frank Arendt-Theilen]

Hallo Daniel,
trage das folgende XL8/XL9-Makro in deine PERSONL.XLS ein und weise es
einer Symbolleistenschaltfläche zu. Das Makro kann auf die jeweils
aktive Arbeitsmappe angewandt werden und verbindet Zellen mit gleichen
Inhalt nebeneinander:

Sub VerbindenNebeneinander()
Dim rngZelle As Range, intZähler As Integer, strAdresse As String
Application.DisplayAlerts = False
For Each rngZelle In ActiveSheet.UsedRange
If Not IsEmpty(rngZelle) Then
intZähler = 0
Do
strAdresse = rngZelle.Offset(0, intZähler).Address
intZähler = intZähler + 1
Loop Until rngZelle.Value <> rngZelle.Offset(0, intZähler).Value
ActiveSheet.Range(rngZelle.Address, strAdresse).Merge
End If
Next
Application.DisplayAlerts = True
End Sub

MfG Frank
__________________________________________________________
Frank Arendt-Theilen, Microsoft MVP für Excel
E-Mail: Thei...@t-online.de

Am Thu, 06 Jan 2000 13:11:56 GMT, schrieb Daniel.Fr...@gmx.de in
microsoft.public.de.excel zu "Zellen verbinden wenn gleiche
nebeneinander":

[Peter Rühm]

Hallo Frank,
praktisch, aber kracht bei Formeln!
Kleiner Ergänzungsvorschlag:
> If Not IsEmpty(rngZelle) Then
ändern in
If Not (IsEmpty(rngZelle) Or rngZelle.HasFormula) Then

Kann man das irgendwie besser formulieren?

Gruß aus dem kalten Augsburg
Peter

[Frank Arendt-Theilen]

Hallo Peter,
danke für deine Korrektur. Bei meinen Tests habe ich die Eintragung
von Formeln überhauptnicht mit einbezogen.

MfG Frank
__________________________________________________________
Frank Arendt-Theilen, Microsoft MVP für Excel
E-Mail: Thei...@t-online.de

Am Fri, 7 Jan 2000 10:05:29 +0100, schrieb "Peter Rühm"
<XXXp....@prt.de> in microsoft.public.de.excel zu "Re: Zellen
verbinden wenn gleiche nebeneinander":

>If Not (IsEmpty(rngZelle) Or rngZelle.HasFormula) Then

[Martin Beck]

Hallo Daniel,

versuche mal folgendes Makro:

Sub Verbinden()
a1 = 0
z = ActiveSheet.UsedRange.Rows.Count
s = ActiveSheet.UsedRange.Columns.Count

Application.DisplayAlerts = False
For i = 1 To z
For j = 1 To s
If a1 = 0 Then
a1 = j
a2 = j
End If

If Cells(i, j) = Cells(i, j + 1) Then
a2 = j + 1
Else
Range(Cells(i, a1), Cells(i, a2)).Merge
a1 = 0
End If
Next j
a1 = 0
Next i

Application.DisplayAlerts = True
End Sub

Gruß
Martin Beck

<Daniel.Fr...@gmx.de> schrieb in im Newsbeitrag:
8524ak$o4n$1...@nnrp1.deja.com...