Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1344to1348
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

Kundenselektion

Kundenselektion
21.01.2014 14:19:35
Daniel
Hallo,
ich habe eine kurze Frage an Euch:
ich habe folgenden Tabellenaufbau:
Kundennr Kundenname Kommentar
123 Hans
123 Hans
123 Hans
1234 Sepp
1234 Sepp
12356 Mulu
123457 Lieber
Ich will nun per Makro erreichen, dass nach den gleichen Kundennummern
ein Trennstrich (Rahmenlinie unten) gemacht wird, um die Tabelle ein
bisschen übersichtlicher zu machen.
Beispiel:
A B C
Kundennr Kundenname Kommentar
123 Hans
123 Hans
123 Hans
------------------------------------------
1234 Sepp
Zusätzlich soll dann in der Spalte C die Zeilen verbunden werden
für jede Kundennummer.
Weiß da jemand ne Lösung?
Danke & Gruß

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kundenselektion
21.01.2014 14:51:29
Dani
Huhu,
am besten wertest du die Tabelle als Pivot Tabelle aus, da kannst du dann auch auswählen, welche Zeilen zusammengefasst werden sollen.
Wenn das nicht in Frage kommt: Den Strich machst du am besten über bedingte Formatierung mit der folgenden Formel als Regel:
=INDIREKT(ADRESSE(ZEILE()-1;2;3))INDIREKT(ADRESSE(ZEILE();2;3))
Angewendet auf =$A:$C
und mit Rahmenlinie oben als Formatierung.
Die Formel könnte man auch einfacher gestalten, aber so funzt es auch, wenn du umsortierst.
Zellen verbinden müsstest du per Makro machen, dann ist es aber recht umständlich eine neue Zeile hinzuzufügen, darum würde ich persönlich davon abraten, Zellen zu verbinden und das lieber in der Pivot auswerten.
Ich habe dir deine Tabelle mal so formatiert als Beispiel angehangen + eine Pivot Tabelle eingefügt: https://www.herber.de/bbs/user/88928.xlsx
Viele Grüße,
Dani

Anzeige
AW: Kundenselektion
21.01.2014 15:28:01
UweD
Hallo
hier eine Macrolösung...
  Sub Gruppe_Linie_danach()
Dim i&, TT&, RR&
With ActiveSheet
RR = .Cells.SpecialCells(xlCellTypeLastCell).Row 'Letzte Zeile des gesamten Blattes
.Cells.Borders.LineStyle = xlNone 'alle Linien aus
.Columns(3).MergeCells = False '
TT = 1
For i = 1 To RR
If .Cells(i, 1).Value  "" And .Cells(i + 1, 1).Value  _
.Cells(i, 1).Value Then
With .Range(.Cells(i, 1), Cells(i, 3)).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
If i  TT Then .Range(.Cells(TT, 3), Cells(i, 3)).MergeCells = True
TT = i + 1
End If
Next
End With
End Sub

Gruß UweD

Anzeige
AW: Kundenselektion
21.01.2014 15:49:51
Daniel
Hallo Uwe,
super Sache!
Du prüfst jetzt da die Kundennummer und den Kundennamen ab oder?
Die Kundennummer ist in meiner richtigen Tabelle (in Spalte D) eine Auftragsnummer
die eindeutig ist.
Kann man den Code soweit hin kürzen, dass nur die Auftragsnummer geprüft wird?
Sry, für den Umstand!
Danke!
Gruß Daniel

AW: Kundenselektion
22.01.2014 08:27:50
UweD
Hallo
Nein es wird nur die erste Spalte verglichen.
If .Cells(i, 1).Value "" And .Cells(i + 1, 1).Value .Cells(i, 1).Value Then
1) ist in der Zelle überhaupt was drin
2) ist der Inhalt der Zelle gleich dem Inhalt der nächsten Zelle
Hier die Änderung auf Spalte D (kannst du durch die Variable SP an einer Stelle auch anpassen)
  Sub Gruppe_Linie_danach()
Dim i&, TT&, RR&, Sp%
Sp = 4 ' Spalte D wird untersucht
With ActiveSheet
RR = .Cells.SpecialCells(xlCellTypeLastCell).Row 'Letzte Zeile des gesamten Blattes
.Cells.Borders.LineStyle = xlNone 'alle Linien aus
.Columns(Sp + 2).MergeCells = False ' Vurbundene Zellen werden gelöst
TT = 1
For i = 1 To RR
If .Cells(i, Sp).Value  "" And .Cells(i + 1, Sp).Value  _
.Cells(i, Sp).Value Then
With .Range(.Cells(i, Sp), Cells(i, Sp + 2)).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
If i  TT Then .Range(.Cells(TT, Sp + 2), Cells(i, Sp + 2)).MergeCells = True
TT = i + 1
End If
Next
End With
End Sub
Gruß UweD
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige