Supportnet Computer
Planet of Tech

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

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

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

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.

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

Antwort 6 von michael oberley

hi teddy

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

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

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

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

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

Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: