Supportnet / Forum / Tabellenkalkulation
Makro oder Autosortieren ??
Frage
Hallo,
wer kann mir bei meinem Problem helfen?
ich möchte ein Telefonregister unter Excel 97 eingerichtet, sortieren. Es ist jeweils mit Name (1. Spalte) und Tel. Nr. (2 Spalte) eingerichtet. Damit mein Tel Register nicht unendlich lang wird habe ich es mit mit insgesamt 6 Spalten belegt (3 Reihen a 2 Spalten nebeneinander). Jetzt mein Problem, kommt ein neuer dazu oder einer fällt weg, muß ich mit unendlich viel ausschneiden und kopieren neu sortieren. Dazu möchte ich die Gruppen (z.B. Nr. 11 bis 100, 101-200 usw.) trennen können. Der hinzugefügte Name mit der Tel Nr. sollte sich automatisch an die richtige Stelle sortieren und wenn einer gelöscht wird sollten keine Leerspalten entstehen.
Wäre toll wenn jemand dazu ein Makro hätte (kenne mich damit nämlich überhaupt nicht aus), denn mit Autosortieren geht es glaube ich nicht mehr.
Antwort 1 von Teddy7
Hi Kismo !
Welche Spalten hast Du belegt ? A,B,C,D,E F oder hast Du Leerspalten dazwischen ?
Sortierung nach Spalte A, C, E - also nach Namen - oder alternativ nach Nummer(könnte bei isdn-Verbindungen interessant werden weil manche Telefone die Nummern der letzten Anrufe speichern).
Die ersten 3 in Zeile 1 ausgeben usw. ?
Gruß
Teddy
Welche Spalten hast Du belegt ? A,B,C,D,E F oder hast Du Leerspalten dazwischen ?
Sortierung nach Spalte A, C, E - also nach Namen - oder alternativ nach Nummer(könnte bei isdn-Verbindungen interessant werden weil manche Telefone die Nummern der letzten Anrufe speichern).
Die ersten 3 in Zeile 1 ausgeben usw. ?
Gruß
Teddy
Antwort 2 von Kismo
Hallo Teddy,
ich habe die Spalten A,B D,E und G,H belegt, C und F als Leerspalte jeweils dazwischen. In Spalte A steht der Name, in Spalte B die dazugehörige Tel. Nr. (gleiches in D,E und G,H). Ab und zu fällt Name raus und es sollen dann keine leeren Zellen stehen bleiben, bzw. ich habe einen neuen Namen, der sich dann automatisch an der richtigen Stelle einsortieren soll. Es müßte sich also auf der Seite beim entfernen des allerersten Namens der 1. Name in C,D als letzter unten in A,B sortieren.
Gruß Kismo
ich habe die Spalten A,B D,E und G,H belegt, C und F als Leerspalte jeweils dazwischen. In Spalte A steht der Name, in Spalte B die dazugehörige Tel. Nr. (gleiches in D,E und G,H). Ab und zu fällt Name raus und es sollen dann keine leeren Zellen stehen bleiben, bzw. ich habe einen neuen Namen, der sich dann automatisch an der richtigen Stelle einsortieren soll. Es müßte sich also auf der Seite beim entfernen des allerersten Namens der 1. Name in C,D als letzter unten in A,B sortieren.
Gruß Kismo
Antwort 3 von Teddy7
Hallo Kismo !
Sowas gibt´s natürlich nicht.
Aber ich könnte Dir ein makro schreiben, daß alles Daten neu sortiert.
Die Frage ist nur wieviele Namen kommen in Spalte A.
Könnte man vielleicht die Gesamtanzahl der Namen ermitteln und ein Drittel davon in Spalte A,B schreiben, usw. ?
Gruß
Teddy
Sowas gibt´s natürlich nicht.
Aber ich könnte Dir ein makro schreiben, daß alles Daten neu sortiert.
Die Frage ist nur wieviele Namen kommen in Spalte A.
Könnte man vielleicht die Gesamtanzahl der Namen ermitteln und ein Drittel davon in Spalte A,B schreiben, usw. ?
Gruß
Teddy
Antwort 4 von michael oberley
hi teddy7
vielleicht hilfreich fuer dich ein makro was beim verlassen einer zelle aktiv wird unter tabellenname code einzugeben,makro01 ist das aufzurufende makro.
gruss nighty
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Value <> "" Then
Call Makro01
End If
End Sub
p.s.
uebrigens auch vom sn bekommen.
vielleicht hilfreich fuer dich ein makro was beim verlassen einer zelle aktiv wird unter tabellenname code einzugeben,makro01 ist das aufzurufende makro.
gruss nighty
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Value <> "" Then
Call Makro01
End If
End Sub
p.s.
uebrigens auch vom sn bekommen.
Antwort 5 von Teddy7
@nighty
ist ja nett gemeint, aber dann würde das makro bei JEDEM Zellenwechsel anlaufen. Wenn ich mir jetzt vorstelle, ich erfasse einen neuen Namen, will dann in der nächsten Zelle die TelNr erfassen und .........
Gruß
Teddy
ist ja nett gemeint, aber dann würde das makro bei JEDEM Zellenwechsel anlaufen. Wenn ich mir jetzt vorstelle, ich erfasse einen neuen Namen, will dann in der nächsten Zelle die TelNr erfassen und .........
Gruß
Teddy
Antwort 6 von michael oberley
hi teddy
ohje stimmt ja leider,bis zum naechstenmal dann einen schoenen tag noch alle.
gruss nighty
ohje stimmt ja leider,bis zum naechstenmal dann einen schoenen tag noch alle.
gruss nighty
Antwort 7 von klaus.stachuletz
Hi Kismo,
ich habe das Problem wie folgt gelöst:
Eine Basistabelle, in der alle Datensätze untereinander stehen. Diese Tabelle kannst du entweder zu Fuß oder auch per Makro sortieren.
In einer zweiten Tabelle erfolgt die Ausgabe in der von dir gewünschten Form, also nebeneinander.
Du holst dir einfach die in Tabelle1 stehenden Werte per Funktion mit absoluten Bezügen.
Beispiel: In Tabelle1ZelleA2 steht der Name
In Tabelle2ZelleB2 steht : Tabelle1!$A$2
Falls du noch am Kürprogramm Interesse hast und links neben den Namen ein automatisches Register einfügen willst, dann geht das mit dieser Formel:
=WENN(LINKS(B2;4)="Name";LINKS(B3;1);WENN(LINKS(B3;1)>LINKS(B2;1);LINKS(B3;1);""))
In Zelle B1 steht als SPaltenüberschrift "Name", in Zelle A2 zu Fuß der Buchstabe "A".
Viele Grüsse
Klaus
ich habe das Problem wie folgt gelöst:
Eine Basistabelle, in der alle Datensätze untereinander stehen. Diese Tabelle kannst du entweder zu Fuß oder auch per Makro sortieren.
In einer zweiten Tabelle erfolgt die Ausgabe in der von dir gewünschten Form, also nebeneinander.
Du holst dir einfach die in Tabelle1 stehenden Werte per Funktion mit absoluten Bezügen.
Beispiel: In Tabelle1ZelleA2 steht der Name
In Tabelle2ZelleB2 steht : Tabelle1!$A$2
Falls du noch am Kürprogramm Interesse hast und links neben den Namen ein automatisches Register einfügen willst, dann geht das mit dieser Formel:
=WENN(LINKS(B2;4)="Name";LINKS(B3;1);WENN(LINKS(B3;1)>LINKS(B2;1);LINKS(B3;1);""))
In Zelle B1 steht als SPaltenüberschrift "Name", in Zelle A2 zu Fuß der Buchstabe "A".
Viele Grüsse
Klaus
Antwort 8 von Teddy7
Hallo Kismo !
Versuchs mal hiermit:
---------------
Sub Makro1()
Dim i1 As Integer
Dim i2 As Integer
Dim t1 As Integer
Dim t2 As Integer
Dim lastrow1 As Integer
Sheets(1).Select
With Range("A1")
lastrow1 = .SpecialCells(xlCellTypeLastCell).Row
End With
i2 = 0
For i1 = 1 To lastrow1
If Cells(i1, 1) <> "" And Cells(i1, 1) <> " " And _
Not (IsNull(Cells(i1, 1))) Then
i2 = i1
End If
If Cells(i1, 4) <> "" And Cells(i1, 4) <> " " And _
Not (IsNull(Cells(i1, 4))) Then
i2 = i1
End If
If Cells(i1, 7) <> "" And Cells(i1, 7) <> " " And _
Not (IsNull(Cells(i1, 7))) Then
i2 = i1
End If
Next i1
lastrow1 = i2
i2 = lastrow1
For i1 = 1 To lastrow1
If Cells(i1, 4) <> "" And Cells(i1, 4) <> " " And _
Not (IsNull(Cells(i1, 4))) Then
i2 = i2 + 1
Cells(i2, 1) = Cells(i1, 4)
Cells(i2, 2) = Cells(i1, 5)
Cells(i1, 4) = ""
Cells(i1, 5) = ""
End If
Next i1
For i1 = 1 To lastrow1
If Cells(i1, 7) <> "" And Cells(i1, 7) <> " " And _
Not (IsNull(Cells(i1, 7))) Then
i2 = i2 + 1
Cells(i2, 1) = Cells(i1, 7)
Cells(i2, 2) = Cells(i1, 8)
Cells(i1, 7) = ""
Cells(i1, 8) = ""
End If
Next i1
lastrow1 = i2
xbereich = "A1:B" & lastrow1
Range(xbereich).Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
t1 = 1
t2 = 1
For i1 = 1 To lastrow1
Cells(t1, t2) = Cells(i1, 1)
t2 = t2 + 1
Cells(t1, t2) = Cells(i1, 2)
If i1 <> lastrow1 Then
t2 = t2 + 2
If t2 > 7 Then
t1 = t1 + 1
t2 = 1
End If
End If
Next i1
t1 = t1 + 1
Rows(t1 & ":" & lastrow1).Select
Selection.Delete Shift:=xlUp
ActiveWorkbook.Save
Cells(1, 1).Select
End Sub
-------------
Ich empfehle, vorher die Exceldatei zu sichern, weil ich nur mit wenigen Daten testen konnte.
Gruß
Teddy
Versuchs mal hiermit:
---------------
Sub Makro1()
Dim i1 As Integer
Dim i2 As Integer
Dim t1 As Integer
Dim t2 As Integer
Dim lastrow1 As Integer
Sheets(1).Select
With Range("A1")
lastrow1 = .SpecialCells(xlCellTypeLastCell).Row
End With
i2 = 0
For i1 = 1 To lastrow1
If Cells(i1, 1) <> "" And Cells(i1, 1) <> " " And _
Not (IsNull(Cells(i1, 1))) Then
i2 = i1
End If
If Cells(i1, 4) <> "" And Cells(i1, 4) <> " " And _
Not (IsNull(Cells(i1, 4))) Then
i2 = i1
End If
If Cells(i1, 7) <> "" And Cells(i1, 7) <> " " And _
Not (IsNull(Cells(i1, 7))) Then
i2 = i1
End If
Next i1
lastrow1 = i2
i2 = lastrow1
For i1 = 1 To lastrow1
If Cells(i1, 4) <> "" And Cells(i1, 4) <> " " And _
Not (IsNull(Cells(i1, 4))) Then
i2 = i2 + 1
Cells(i2, 1) = Cells(i1, 4)
Cells(i2, 2) = Cells(i1, 5)
Cells(i1, 4) = ""
Cells(i1, 5) = ""
End If
Next i1
For i1 = 1 To lastrow1
If Cells(i1, 7) <> "" And Cells(i1, 7) <> " " And _
Not (IsNull(Cells(i1, 7))) Then
i2 = i2 + 1
Cells(i2, 1) = Cells(i1, 7)
Cells(i2, 2) = Cells(i1, 8)
Cells(i1, 7) = ""
Cells(i1, 8) = ""
End If
Next i1
lastrow1 = i2
xbereich = "A1:B" & lastrow1
Range(xbereich).Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
t1 = 1
t2 = 1
For i1 = 1 To lastrow1
Cells(t1, t2) = Cells(i1, 1)
t2 = t2 + 1
Cells(t1, t2) = Cells(i1, 2)
If i1 <> lastrow1 Then
t2 = t2 + 2
If t2 > 7 Then
t1 = t1 + 1
t2 = 1
End If
End If
Next i1
t1 = t1 + 1
Rows(t1 & ":" & lastrow1).Select
Selection.Delete Shift:=xlUp
ActiveWorkbook.Save
Cells(1, 1).Select
End Sub
-------------
Ich empfehle, vorher die Exceldatei zu sichern, weil ich nur mit wenigen Daten testen konnte.
Gruß
Teddy
Antwort 9 von Kismo
Hi Teddy,
wenn das Makro probiere, bekomme ich einen Laufzeitfehler (1004, Die Methode Range Global für das Objekt ist fehlgeschlagen)) für den Bereich Range(xbereich).Select. Was mache ich falsch?
Gruß
Kismo
wenn das Makro probiere, bekomme ich einen Laufzeitfehler (1004, Die Methode Range Global für das Objekt ist fehlgeschlagen)) für den Bereich Range(xbereich).Select. Was mache ich falsch?
Gruß
Kismo
Antwort 10 von Teddy7
Hallo Kismo !
Da versagt meine Kristallkugel. Ich hab´s natürlich bei mir ausprobiert und da klappt´s. Ich kann Dir nur anbieten, mir die Datei mal zuzumailen.
Gruß
Teddy
Da versagt meine Kristallkugel. Ich hab´s natürlich bei mir ausprobiert und da klappt´s. Ich kann Dir nur anbieten, mir die Datei mal zuzumailen.
Gruß
Teddy
Antwort 11 von Kismo
Ein herzliches Dankeschön an Teddy. Er hat mir per e-mail die richtige Lösung gegeben. Da ich nicht so oft Zeit habe, hat es etwas gedauert, wobei Teddy immer sehr schnell geantwortet hat.
Gruß
Kismo
Gruß
Kismo

