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
1392to1396
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

Automa gleiche Zellen in mehreren Zeilen verbinden

Automa gleiche Zellen in mehreren Zeilen verbinden
24.11.2014 12:54:52
Balu
Hallo Leute!
Ich suche mich schon seit Tagen kaputt, finde aber leider keine 100%ig funktionierende Lösung für mein Problem.
Ich habe schon alles versucht, was ich so gefunden habe und auch versucht die Makros auf mein Problem anzupassen (aufgrund mangelnder vernünftiger VBA Kenntnisse gescheitert)
Ich füge hier einfach mal das Makro ein, was meiner Meinung nach am Besten funktioniert.
Jedoch funktioniert das nur für die angegebene Zeile, ich möchte es aber für 4 Zeilen (1-4)
Ich hab überall gelesen, dass man das auch mit bedingter Formatierung lösen kann, das habe ich aber auch nicht hingekriegt :(
Hintergrund: Ich habe eine riesen Tabelle, in der alle Daten von jedem Tag im Jahr automatisch generiert werden (d.h. 365 Spalten)
Aufgrund dieser Daten werden in den 4 Zeilen drüber Kalenderwoche, Monat, Quartal, und Jahr ausgegeben.
Diese Werte sollen dann zusammengefasst werden, wenn sie gleich sind (nur für optische zwecke, von daher wäre VBA ok, dann müsste ich nur einmal zum Jahresende die Zeilen wieder überschreiben)
Also: Wenn ihr mir sagen könnt, wie ich das mit Bedingter Formatierung lösen kann, wäre super.
Ansonsten: hier ist der Code, der angepasst werden kann

Sub VerbindenGleicheWerte()
Dim Zeile As Long
Dim Zelle1 As Range
Dim Zelle2 As Range
Dim rngZeile As Range
Dim sp As Long
Dim Verbinden As Boolean
Zeile = 14
Set rngZeile = Intersect(ActiveSheet.UsedRange, Rows(Zeile))
Set Zelle1 = rngZeile.Cells(1, 1)
For sp = 3 To rngZeile.Columns.Count + 1
If rngZeile.Cells(1, sp) = Zelle1 Then
Verbinden = True
Else
With Range(Zelle1, rngZeile.Cells(1, sp - 1))
If Verbinden = True Then
.Offset(0, 1).Resize(1, .Columns.Count - 1).ClearContents
.merge
.HorizontalAlignment = xlCenter
End If
End With
Verbinden = False
Set Zelle1 = rngZeile.Cells(1, sp)
End If
Next
End Sub

Ich danke schonmal für Mühe und Antworten!

37
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Na, dann iat das vielleicht was für dich, ...
24.11.2014 14:39:48
Balu
hui, Luc, ich denke das ist für mein Problem ein bisschen zu heavy :D

Wieso, es kommt doch auf das Ergebnis an! owT
24.11.2014 15:10:35
Luc:-?
:-?

Nebenbei, für LinkFolger aus dem MOF; ...
24.11.2014 15:38:49
Luc:-?
…wer wie ein gewisser Earl Fred aus dem MOF VerbundZellen pauschal als „Mist“ abtut und dann dort die bekannte StandardLösung anbietet, schmückt sich sehr zu unrecht mit einem „Adelstitel“, denn das zeugt in meinen Augen nicht gerade von Xl/VBA-Kompetenz, sondern nur von gedankenloser Nachbeterei der vermeintlichen Mehrheitsmeinung.
Merke: Auch Mehrheiten schützen nicht vor Irrtümern! Immerhin war eine Mehrheit mal der Ansicht, die Erde sei eine Scheibe und die Sonne drehe sich um sie (einige glauben das ja auch heute noch → um die zu finden, muss man nur mal nach geozentrischem Weltbild googeln)!
Übrigens, Balu,
Ein universales Tool muss alles oder wenigstens soviel wie möglich berücksichtigen, sonst wäre es ja nicht universal, also ohne Anpassung (für den angegebenen Zweck und mit den ggf genannten Einschränkungen) allgemein verwendbar. Alles Andere ist eine sog InselLösung! Letztere wdn in Foren ohnehin massenhaft produziert und landen letztlich schneller im EDV-Nirvana des Vergessens als man glauben will.
Luc :-?

Anzeige
hier mein Lösungsvorschlag...
24.11.2014 15:18:57
Tino
Hallo,
Sub VerbindenGleicheWerte()
Dim ArData, varWert, rngVerbund As Range, rngData As Range
Dim n&, nn&, MaxCol&, AbZeile&, AbSpalte&

AbZeile = 14
AbSpalte = 3

With Tabelle1 'Tabelle anpassen !!! 
    Set rngData = .Range(.Cells(AbZeile, AbSpalte), .Cells(.Rows.Count, AbSpalte).End(xlUp))
    If rngData.Rows(1).Row < AbZeile Then Exit Sub
    Set rngData = rngData.Resize(, .Columns.Count - rngData.Columns(1).Column + 1)
    Set rngData = Intersect(rngData, .UsedRange)
    If rngData Is Nothing Then Exit Sub
    If rngData.Columns.Count < 2 Then Exit Sub
End With

On Error GoTo ErrorHandler:
Events_ False

For n = 1 To rngData.Rows.Count
    
    ArData = rngData.Rows(n).Value2
    varWert = ArData(1, 1)
    MaxCol = Ubound(ArData, 2)
    
    For nn = 2 To MaxCol
        If varWert = ArData(1, nn) Then
            If Not rngVerbund Is Nothing Then
                Set rngVerbund = Union(rngVerbund, rngData.Cells(n, nn - 1).Resize(, 2))
            Else
                Set rngVerbund = rngData.Cells(n, nn - 1).Resize(, 2)
            End If
        End If
        
        If varWert = ArData(1, nn) Or nn = MaxCol Then
            If Not rngVerbund Is Nothing Then
                For Each rngVerbund In rngVerbund.Areas
                    If Not rngVerbund.MergeCells Then
                        varWert = rngVerbund.Cells(1, 1).Value
                        rngVerbund.ClearContents
                        rngVerbund.Merge
                        rngVerbund.Cells(1, 1).Value = varWert
                    End If
                Next rngVerbund
                Set rngVerbund = Nothing
            End If
        End If
        
        varWert = ArData(1, nn)
    Next nn
Next n

ErrorHandler:

Events_ True

If Err.Number <> 0 Then
    MsgBox Err.Description, _
           vbCritical + vbMsgBoxSetForeground + vbMsgBoxHelpButton, _
           "Error: " & Err.Number, Err.HelpFile, Err.HelpContext
End If
End Sub

Sub Events_(booSchalter As Boolean)
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
    .Calculation = IIf(booSchalter, xlCalculationAutomatic, xlCalculationManual)
End With
End Sub
Gruß Tino

Anzeige
AW: hier mein Lösungsvorschlag...
24.11.2014 15:34:47
Balu
hey Tino,
viele Dank für deine Mühe und Lösungsvorschlag.
Leider bekomme ich eine Fehlermeldung: Laufzeitfehler 424, Objekt erforderlich
Folgende Zeile wird gelb markiert: Set rngData = .Range(.Cells(AbZeile, AbSpalte), .Cells(.Rows.Count, AbSpalte).End(xlUp))
Wie passe ich den Code an, dass nur bis zu einer bestimmten Zeile gesucht wird?
Ich hätte in der obigen Zeile .Cells(.Rows.Count, AbSpalte).End(xlUp) durch .Cells(EndZeile, AbSpalte).End(xlUp) ersetzt, wäre das richtig?

hier meine Testdatei
24.11.2014 16:38:11
Tino
Hallo,
im Code kannst du dies einstellen, ab welcher Zeile, Spalte und wieviel Spalten!
AbZeile = 14
AbSpalte = 3
MaxSpalten = 4
https://www.herber.de/bbs/user/93989.xlsm
Gruß Tino

Anzeige
AW: hier meine Testdatei
25.11.2014 08:01:53
Balu
Hey Tino,
ich habe jetzt erst deine Testdatei gesehen.
Ja das mit AbZeile, AbSpalte und MaxSpalten ist richtig, aber ich bräuchte eine Variable BisZeile.
Ich krieg die nicht vernünftig eingebaut :/
Dein Makro fügt nur die angegebene Zeile bei AbZeile zusammen :/

das ergibt sich doch automatisch
25.11.2014 11:23:28
Tino
Hallo,
AbZeile und MaxSpalten ergibt doch einen definierten Bereich?!
Bsp.
AbZeile 4 und MaxSpalten 5 = Zeile 4 bis 8
AbZeile 12 und MaxSpalten 1 = Zeile 12 bis 12
(MaxSpalten ist falsch gewählt, müsste eigentlich MaxZeilen heißen)
Gruß Tino

AW: das ergibt sich doch automatisch
25.11.2014 12:54:39
Balu
gut damit hätte sich das geklärt, war mit der Bezeichnung natürlich etwas verwirrend :D
vielen vielen Dank für diese (auf mich persönlich zugeschnittene (!!!!)) Insellösung. Top!

Anzeige
Die Neigung der Deutschen, das Fahrrad immer ...
24.11.2014 15:43:16
Luc:-?
…wieder neu zu erfinden, scheint ungebrochen. Wieder eine Insel-„Lösung“ mehr… :->
Luc :-?

Mach so viel wie nötig, aber so wenig wie möglich!
24.11.2014 16:43:15
Tino
Hallo,
sonst sind die für mich nicht zu gebrauchen, lieber mach ich die täglich neu!
Gruß Tino

Das wäre was, wenn die Pgmierer einer ...
24.11.2014 17:38:42
Luc:-?
…universellen Software wie Xl dieser „Logik“ gefolgt wären, Tino,
dann müsste man für jedes TeilProblem eine andere XlVersion benutzen… :->>
Letztlich müllen sich die so Handelnden nur ihren Rechner voll bzw jedes Projekt ist in sich geschlossen und kann nicht anderweitig verwendet oder (teil-)genutzt wdn.
InselLösungen sind die PlastikTüten der EDV, AddIns mit Universal-Tools die rationelle Lösung!
Luc :-?

Anzeige
AW:Luc du musst endlich mal lernen...
24.11.2014 17:49:31
Daniel
zwischen einem Profi-Programmierer und einem einfachen Excelandwender mit rudimentären Programmierkenntnissen zu differnzieren.
Profis und solche die es werden wollen, stellen hier mit Sicherheit keine Fragen.
Das Problem ist, das mit zunehmender "universalität" der Aufwand und die Komplexität der Lösung exponential zunimmt und für die meisten Hobby-Anwender die einfache Insellösung die bessere ist, weil der mit der "eierlegenden Wollmilchsau" schlichtweg überfordert ist.
Gruß Daniel

Warum denn, er muss sie ja nur anwenden, ...
24.11.2014 18:04:28
Luc:-?
…weil alles bereits fertig ist, Daniel;
und ich entscheide immer noch selbst, was ich lernen will. Bestimmt muss ich keine „Tiefflug“-EDV, auch nicht von dir oder diversen „PlastikTüten“-Produzenten „lernen“! Wer nicht mal daran denkt, seine Pgmm pflegeleicht bzw anpassungsfähig zu schreiben, obwohl hier schon desöfteren darauf hingewiesen wurde, ist für mich einfach nicht ernst zu nehmen…
Luc :-?

Anzeige
AW: Warum denn, er muss sie ja nur anwenden, ...
25.11.2014 07:53:47
Balu
wenn mir jemand sagen könnte, wie ich die Formel auf das o.g. Problem anpassen kann, wäre ich sehr dankbar, ich kriege es alleine leider nicht hin (da kommt immer irgendein Mist raus :( )

AW: AW:Luc du musst endlich mal lernen...
25.11.2014 12:55:39
Balu
"Das Problem ist, das mit zunehmender "universalität" der Aufwand und die Komplexität der Lösung exponential zunimmt und für die meisten Hobby-Anwender die einfache Insellösung die bessere ist, weil der mit der "eierlegenden Wollmilchsau" schlichtweg überfordert ist."
genau so sieht es nämlich aus!

Siehe meine AW oben; 'universal' heißt auch ...
25.11.2014 17:01:54
Luc:-?
ohne nennenswerten AnpassungsAufwand, aber so etwas seid ihr Code-„Zusammenklauber“ und -Anpasser ja wohl nicht gewohnt… :->
Allerdings kann es dann gut sein, dass ihr einen solchen Code nicht versteht, aber den so mancher XlFkt würdet ihr ja auch nicht verstehen, nur seht ihr ihn nicht, was mich in meiner Auffassung bestärkt, so etwas nur ausnahmsweise zu zeigen!
Bastelt mal schön weiter…! ;->
Luc :-?

Anzeige
AW: Siehe meine AW oben; 'universal' heißt auch .
25.11.2014 17:54:20
Daniel
lieber basteln, als für Code, den man nicht versteht, verantwortlich sein zu müssen.

Deshalb hat es offensichtlich keinen Sinn, ...
25.11.2014 18:53:01
Luc:-?
…hier so etwas zu zeigen, obwohl ich da weder der Erste war noch der Einzige bin. Aber die Doku nicht vergessen, sonst landet alles idR spätestens bei Verantwort­lichkeits­wechsel im Müll oder wir dürfen uns dann mit den zusammen­gestoppelten Basteleien aus­ein­ander­set­zen → ohne mich…!
Luc :-?

ich lege mehr wert auf Geschwindigkeit...
24.11.2014 19:19:54
Tino
Hallo,
soweit es meine Kenntnisse/Ideen zulassen!
Meist sollen die auch nicht für die ganze Welt sein sondern nur mein Problem effizient lösen.
Gruß Tino

Anzeige
Dann wirst du aber hoffentlich auch die ...
25.11.2014 05:04:17
Luc:-?
…Übersicht behalten, was ich bei vielen VBA-Anfängern bezweifle; und ohne ordentliche Doku kann dann kein evtl Nachfolger was damit anfangen.
Luc :-?

AW: Dann wirst du aber hoffentlich auch die ...
25.11.2014 10:12:37
Daniel
es ist verdammt schwer, eine ordentliche Doku für Codes zu schreiben, die man sich irgendwo aus dem Internet zusammenkopiert hat und die man nur anwendenden kann, ohne sie zu verstehen.
Gruss Daniel

Wennde recht hast, haste ooch recht...! ;-]
25.11.2014 16:54:04
Luc:-?
:-?

AW: Werte stehen lassen, Bedingte Formatierung
24.11.2014 17:17:21
Daniel
Hi
wenn du damit leben kannst, dass bei einem Wechsel der neue Text links (dh in der ersten Zelle des Bereichs) steht, dann einfach mit Bedingter Formatierung.
Annahme:
der Kalender beginnt ab Spalte B!
dann Zellen B1-NC4 markieren und folgende Bedingte Formatierung anlegen:
Formel: =B1A1
Format: Schriftfarbe schwarz; Rahmen links
Grundformat der Zelle: Schriftfarbe = Hintergrundfarbe
Gruß Daniel

Anzeige
Das wäre neben analoger benutzerdefinierter ...
24.11.2014 17:43:01
Luc:-?
…Formatierung die einzig vernünftige Alternative, weil dann ebenfalls noch sinnvoll in dieser Spalte gefiltert wdn kann.
Luc :-?

AW: Filtern geht auch mit Verbundenen Zellen...
24.11.2014 18:04:40
Daniel
... Wenn man zwischen den Kopfzeilen, die die Zellbveründe enthalten und den Datenzeilen eine Leerzeile lässt, so dass diese Zeilen nicht zur eigenetlichen Tabelle gehören.
Sollte man sowieso machen, da eine gefilterte Tabelle nur eine Zeile Überschrift haben sollte.
Gruß Daniel

Fktioniert unter Xl12 aber b.'konventionellen'...
24.11.2014 18:29:35
Luc:-?
…VerbundZellen nicht zuverlässig, Daniel,
bei unkonventionellen VbZellen bzw der FormatierungsLösung aber schon.
Luc :-?

AW: Werte stehen lassen, Bedingte Formatierung
25.11.2014 12:56:35
Balu
Hallo Daniel,
klingt interessant die Lösung. Nur wie ist dann A1 formatiert?

AW: Werte stehen lassen, Bedingte Formatierung
25.11.2014 12:57:23
Balu
Ich wollte nur mal anmerken, dass das Forum hier seeeeehr unübersichtlich ist und Beiträge sehr leicht untergehen. Habe erst jetzt alle Antworten gefunden

So ein Quatsch, ich sehe alle! Gerade die ...
25.11.2014 16:48:53
Luc:-?
Thread-Struktur (FORUMSLISTE) zeigt doch alle BTe, Balu,
und wenn du einen davon gelesen hast, hat der anschließend auf deinem Browser 'ne andere Farbe, was allerdings von deinen Browser-Einstellungen und deinem Umgang mit der Surf-History abhängt.
Gruß, Luc :-?

AW: Werte stehen lassen, Bedingte Formatierung
25.11.2014 13:02:48
Daniel
Hi
der Kalender beginnt zu 99% in Spalte B oder später, weil Spalte A noch die Zeilenbeschriftung enthält, Dh A1 ist sowieso abweichend formatiert.
sollte der Kalender tatsächlich in Spalte A beginnen, so braucht Spalte A keine Bedingte Formatierung, weil du hier immer "am Anfang" bist, dh du kannst hier die Schrift generell Schwarz machen.
Gruß Daniel

AW: Werte stehen lassen, Bedingte Formatierung
25.11.2014 13:13:44
Balu
ok, formatiert ist das falsche Wort.
Was soll in A stehen? Weil bei der bedingten Formaatierung steht ja was von =B1A1
also wenn in A1 jetzt immer was anderes steht, trifft doch die Bedingung immer zu?

AW: Werte stehen lassen, Bedingte Formatierung
25.11.2014 13:38:06
Balu
Ok ich hab es jetzt ausprobiert:
Es werden die ersten beiden Vorkommen ausgegeben (Warum?)
Das die Sachen dann in der ersten Spalte jeweils stehen stört mich nicht, aber das Problem ist, dass die Zeilen so schmal sind, dass da maximal 2 Zahlen reinpassen. Kann man irgenwie zulassen, dass die Ränder überschrieben werden?
Und ich würde gerne die Formatierung verstehen, also was diese Bedingung auslöst (eigentlich bin ich in Excel abgesehen von VBA ziemlich fit, aber irgendwie komme ich nicht dahinter?)

AW: Werte stehen lassen, Bedingte Formatierung
25.11.2014 15:46:10
daniel
Überschreiben von Rändern nur bei Texten und wenn die Nachbarzelle leer ist.
Bei schmalen Spalten kannst du auch den Monatsnamen in Einzelbiuchstaben in die Zellen schreiben.
=teil(text(datum;"MMMM")&wiederholen(" ";31);tag(Datum);1)
Hat den Vorteil, dass alle Zellen einer Zeile den selben Inhalt haben (formel).
Gruss Daniel

AW: Werte stehen lassen, Bedingte Formatierung
25.11.2014 15:56:20
Balu
Mein Fehler habe ich gefunden, hatte eine Spalte ausgelassen.
Ahh, ich wusste gar nicht, dass bedingte Formatierungen so schlau sind und die Formel dann intelligent weiterführt.
Ok, also ist es nicht möglich, über den Rand zu schreiben, wenn die benachbarte Zelle beschrieben ist?
Ansonsten müsste ich die Spalten breiter machen, wäre nicht so optimal, aber naja

315 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige