Hi Leute, ich habe eine Tabelle in der eine Werte in Spalte A mehrfach vorkommen.
z.B.
_ A B C
1 a x x
2 a y y
3 a z z
4 b q q
5 b w w
ich will nun mit einem Makro die Zellen mit gleichem inhalt (aber nur in Spalte A) verbinden, das Ergebnis sollte dann so aussehen:
_ A B C
1 a x x
2 _ y y
3 _ z z
4 b q q
5 _ w w
kann mir da jemand weiter helfen?
Gruß Bullirisiert
PS: (der Unterstrich soll nachher leer sein, hab ich nur eingefügt, da sich sonst alles verschiebt)
Hallo,
mit VBA kann man das lösen.
Wie sind da deine Kenntnisse?
Soll nach der Spalte A sortiert werden?
Gruß
Mark
Ja, Spalte A in Tabellenblatt 3.
bin blutiger Anfänger 
Gruß Bullirisiert
Hallo,
nachstehen ein VBA Code. Diesen solltest Du in der VBA Editor kopieren. Extras -> Macro -> VBA Editor dann einfügen Modul und da reinkopieren. Anschließen „Tabelle1“ gegen deinen Tabellennamen austauschen!
Gruß
Mark
Sub test()
Dim Wks As Worksheet
Dim iAnzahlZeilen As Integer
Dim i As Integer
Dim sWertAlt As String
Set Wks = ThisWorkbook.Sheets(„Tabelle1“)
’ Sortieren der Spalten
Wks.Columns(„A:C“).Sort Key1:=Range(„A1“), Order1:=xlAscending, Key2:=Range(„B1“) _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
'Ermittlung der Zeilenanzahl
iAnzahlZeilen = letzteZeile(Wks.Name, 1)
'Prüfung ob
sWertAlt = Wks.Cells(1, 1)
For i = 2 To iAnzahlZeilen
'Prüfung ob Wert = alter Wert
If Wks.Cells(i, 1) = sWertAlt Then
Wks.Cells(i, 1) = „“
Else
sWertAlt = Wks.Cells(i, 1)
End If
Next i
End Sub
Function letzteZeile(sSheetName As String, iSpalte As Integer)
letzteZeile = Sheets(sSheetName).Cells(Rows.Count, iSpalte).End(xlUp).Row
End Function
Ja, Spalte A in Tabellenblatt 3.
bin blutiger AnfängerGruß Bullirisiert
Super Sache!!!
Das funtioniert!
Vielen Dank und noch nen schönen Tag.
keine Ursache.
Danke für die Rückmeldung.
Gruß
Mark
Super Sache!!!
Das funtioniert!
Vielen Dank und noch nen schönen Tag.
Hi Sobotta, jetzt hab ich noch mal ein Problem und zwar sollte die Sortierung nicht über die ganze Spalte a gehen sondern erst bei A3 beginnen.
Was muss ich da ändern, habs versucht, komm aber nicht drauf
Kannst du mir nochmal helfen?
Hallo Bullirsiert,
nachstehend nochmal der modifizierte Code (gesamt)
Bei den Konstanten (Const) kannst Du die erste Zeile bzw die letzte Spalte angeben.
Gruß
Mark
Sub test()
Dim Wks As Worksheet
Dim iAnzahlZeilen As Integer
Dim i As Integer
Dim sWertAlt As String
Const iAnfangZeileSortierung = 3 '### Dritte Zeile
Const iEndeSpalteSortierung = 3 '####Dritte Spalte
Set Wks = ThisWorkbook.Sheets(„Tabelle1“)
'############nach oben verschoben da es schon benötigt wird
iAnzahlZeilen = letzteZeile(Wks.Name, 1)
’ Sortieren der Spalten
'############# Die Sortierungbereich wird nun als Range definiert die „iAnfangZeileSortierung“ gibt die erste Zeile an die sortiert werden soll
Wks.Range(Cells(iAnfangZeileSortierung, 1), Cells(iAnzahlZeilen, iEndeSpalteSortierung)).Sort Key1:=Range(„A1“), Order1:=xlAscending, Key2:=Range(„B1“) _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
=xlSortNormal
'Ermittlung der Zeilenanzahl
'Prüfung ob
sWertAlt = Wks.Cells(iAnfangZeileSortierung, 1)
For i = iAnfangZeileSortierung + 1 To iAnzahlZeilen
'Prüfung ob Wert = alter Wert
If Wks.Cells(i, 1) = sWertAlt Then
Wks.Cells(i, 1) = „“
Else
sWertAlt = Wks.Cells(i, 1)
End If
Next i
End Sub
Function letzteZeile(sSheetName As String, iSpalte As Integer)
letzteZeile = Sheets(sSheetName).Cells(Rows.Count, iSpalte).End(xlUp).Row
End Function
Hi Mark,
er bringt mir da
Fehler beim Kopilieren
Syntaxfehler
und der Text erscheint rot:
Wks.Range(Cells(iAnfangZeileSortierung, 1), Cells(iAnzahlZeilen, iEndeSpalteSortierung)).Sort Key1:=Range(„A1“), Order1:=xlAscending, Key2:=Range(„B1“) _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
=xlSortNormal
hallo,
tausch die Zeile mal gegen die nachstehende aus:
Wks.Range(Cells(iAnfangZeileSortierung, 1), Cells(iAnzahlZeilen, iEndeSpalteSortierung)).Sort Key1:=Cells(1, iAnfangZeileSortierung), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Sieht schon besser aus, er läuft jetzt auch los aber dann kommt der Laufzeitfehler 1004
Der Sortierbezug ist ungültig.
Der Debugger bleibt an der Stelle wieder stehen:
DataOption1:=xlSortNormal
der komplette Text, den ich als letztes eingefügt habe ist gelb hinterlegt!
Gruß Bullirisiert
zeichne mal mit dem Macrorecorder die Sortierung auf.
Anschließend tauscht Du den Code ab incl. „.Sort…“
Alles klar?
Gruß
Mark
oder besser; schick mir mal deien Datei (wenn geht,wird vertraulich behandelt)
[email protected]
Gruß
M
Ok, so funktioniert es jetzt!
Da wäre aber noch was, wenn man in Spalte A z.B. 3 mal X hat, dann löscht er ja das zweite und dritte raus.
Wenn ich jetzt mit dem Autofilter arbeite, dann es sein, dass genau die erstel Zeile rausfällt und dann bei der zweiten Zeile kein X mehr steht!
Kann man die Zeilen auch verbinden, so dass eine Zelle daraus wird, dann müsste es auch nach dem Autofilter noch i.O. sein.
schalte vorher den Autofilter aus:
If Wks.FilterMode Then Wks.ShowAllData
Gruß
M
Wo genau muss ich das einfügen?
Hat bis jetzt keine Wirkung gezeigt!
Mach jetzt auch mal feierabend!
Danke nochmal für deine hilfe, is echt geil, was ma nda so machen kann…
If Wks.FilterMode Then Wks.ShowAllData
ist neu kannst Du vor dem sortieren reiklatschen.
Bewirkt das der Autofilter nicht filtert!
Gruß
Mark
…
Set Wks = ThisWorkbook.Sheets(„Tabelle1“)
'############nach oben verschoben da es schon benötigt wird
iAnzahlZeilen = letzteZeile(Wks.Name, 1)
If Wks.FilterMode Then Wks.ShowAllData
’ Sortieren der Spalten
'############# Die Sortierungbereich wird nun als Range definiert die „iAnfangZeileSortierung“ gibt die erste Zeile an die sortiert werden soll
Wks.Range(Cells(iA
Hi,
ich leider nicht. Macro´s zählen nicht zu meinen Stärken
Gruss
Hamburgo
Hi Sobotta,
hab dir da noch was per E-mail geschickt.
Gruß Bullirisiert