Hallo,
ich möchte eine Tabelle mittels VBA mit ca 1000 Zeilen und 4 oder 5 Spalten so umdrehen daß die 1.Zeile zum Schluß ist und umgekehrt.
Wie kann ich das angehen?
Danke Hans
ich möchte eine Tabelle mittels VBA mit ca 1000 Zeilen und 4
oder 5 Spalten so umdrehen daß die 1.Zeile zum Schluß ist und
umgekehrt.
Wie kann ich das angehen?
Hi Hans,
muß es Vba sein, sicher das geht natürlich auch, aber es langt doch wenn du in einer Hilfspalte in die oberste zelle einträgst:
=zeile()
danach den gesamten bereich nach dieser Spalte sortierst.
Wenn es denn Vba sein muß, frag nochmal nach, dann kann man dir da was basteln.
Gruß
Reinhard
Hi Hans,
muß es Vba sein, sicher das geht natürlich auch, aber es langt
doch wenn du in einer Hilfspalte in die oberste zelle
einträgst:
=zeile()
danach den gesamten bereich nach dieser Spalte sortierst.Wenn es denn Vba sein muß, frag nochmal nach, dann kann man
dir da was basteln.Gruß
Reinhard
Hallo Reinhard,
ja es muß VBA sein denn es gibt viele solcher Tabellen und die werden schon manipuliert mit einem VBA-Programm und das ist noch was zusätzliches.
Ich bin jetzt draufgekommen daß es einen Befehl „SORT“ gibt mit dem werd ich es versuchen.
Gruß Hans
Wenn es denn Vba sein muß, frag nochmal nach, dann kann man
dir da was basteln.
ja es muß VBA sein denn es gibt viele solcher Tabellen und die
werden schon manipuliert mit einem VBA-Programm und das ist
noch was zusätzliches.
Ich bin jetzt draufgekommen daß es einen Befehl „SORT“ gibt
mit dem werd ich es versuchen.
Hallo Hans,
zeige mal hier deinen vorhandenen Code, dann kann man dann besser sort oder sonstwas gezielt einbauen.
Gruß
Reinhard
Hallo Hans,
zeige mal hier deinen vorhandenen Code, dann kann man dann
besser sort oder sonstwas gezielt einbauen.Gruß
Reinhard
Hallo Reinhard,
da ist der Code:
Sub umordnen()
Dim letzteZeile As Integer
Dim k As Integer
Dim j As Integer
Dim i As Integer
letzteZeile = Range(„A65536“).End(xlUp).Row ’ Feststellung der gefüllten Zeilen
k = 1 ’ Laufvariable Zusammenstellungszeile
j = 1 ’ Laufvariabele Folgezeile/- spalte
For i = k + 1 To letzteZeile 'For Schleife von Zeile 2 bis letzte Zeile
If Range(„B“ & i).Value = „“ Then Exit For ’ Wenn die erste leere Zelle erreicht wird, wird die Schleife verlassen
If Range(„B“ & i).Value
Es geht um eine Temperaturmessung an 3 Meßstellen, die Ergebnisse lese ich aus einer Textdatei ein und ordne sie mit diesem Makro so um daß ich ein diagramm machen kann.
Gruß Hans
Hallo Reinhard,
mein Sortierproblem habe ich jetzt gelöst, und zwar mit:
ActiveSheet.UsedRange.Sort Key1:=Range(„a2“), Order1:=xlAscending, Header:=xlYes, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal ’ Tabelle wird nach aufsteigender Zeit sortiert
Jetzt plagt mich das Diagramm, und das ist schwieriger als ich gedacht hatte. Ich vom einem Buch (von Bernd Held) ein Beispieldiagramm, das macht ähnliches wie ich will und einem Makro von mir, dachte ich könnte das zusammenbasteln - geht nicht so einfach. ich bitte dich um Hilfe dabei.
Die Aufgabenstellung ist folgende: Temperaturmessung mit 3 Meßstellen, alle 10min wird gemessen, eine Tabelle hat ca 950 - 1000 Zeilen, dh ca 3000 Meßwerte.
schaut so aus
Uhrzeit Außen Mauer Innen
05:14:32 7,75 17,50 19,56
05:24:37 7,81 17,50 19,56
05:34:42 7,87 17,50 19,56
05:44:48 7,75 17,50 19,56
05:54:53 7,31 17,50 19,56
Das Diagramm soll ein Liniendiagr.und auf einem neuen Tabellenblatt sein.
Gruß Hans
Hallo Hans,
mein Sortierproblem habe ich jetzt gelöst, und zwar mit:
ActiveSheet.UsedRange.Sort Key1:=Range(„a2“),
Order1:=xlAscending, Header:=xlYes, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal '
Tabelle wird nach aufsteigender Zeit sortiert
sorry, ich hatte deinen geposteten Code schon gelesen, hatte dazu und auch zum Einbau einer Sortierung auch sponaten Ideen, aber hab dann irgendwie was anderes gemacht.
Jetzt plagt mich das Diagramm, und das ist schwieriger als ich
gedacht hatte. Ich vom einem Buch (von Bernd Held) ein
Beispieldiagramm,
Vorm nächsten Buchkauf frage mal hier oder in anderen Excelforen nach damit dieser Fehler nicht wieder geschieht.
das macht ähnliches wie ich will und einem
Makro von mir, dachte ich könnte das zusammenbasteln - geht
nicht so einfach. ich bitte dich um Hilfe dabei.
Kein Problem, mache ich gerne. So wie es mir erscheint, hast du woher und wie auch immer in einem Tabellenblatt irgendwelche Meßreihen die über einige Spalten verteilt sind.
Du willst diese Daten a) sortieren nach irgendeinem Spaltenschlüsseln und dann b) daraus ein Liniendiagramm bilden.
Wenn das korrekt ist, schmeiß das Buch in die Tonne und bastle eine Beispielmappe wo im Blatt1 die Daten so aussehen wie du sie hast/erhälst
Im zweiten Blatt trägst du manuell oder per Makro ein wie sie nach Sortierung durch ein Makro aussehen sollen als Tabelle, und darauf begründet erstellst du in einem dritten Blatt dein Liniendiagramm.
Dann schau ich/andere mal, wie man das hinbiegt per Makro aus den Rohdaten in Blatt1 das Liniendiagramm in Blatt3 zu erstellen.
Noch was, zwar grad gelesen aber deine genaue Wortwahl vergessen 
, du schriebst was von 4 oder 5 Spalten, das ist zwar handelbar, aber ein Makro hat es lieber genau gesagt zu bekommen sortiere nach der 4ten Spalte oder sortiere nach der 5ten Spalte.
Wenn das unklar ist so braucht das Makro exakte Angaben wodran auch immer es erkennen kann daß es nach der 4ten oder 5ten oder xten Spalte sortieren soll.
Hochladen kannste die Beispielmappe via FAQ:2861 o.ä.
Gruß
Reinhard
Hallo Reinhard,
ich bin sehr froh über deine Hilfe, die Probleme werden immer mehr statt weniger.
Die Sortierung habe ich doch nicht geschafft, ich habe im Test mit, wenig Werten, nach der Uhrzeit sortiert und nicht berücksichtigt daß ich über 7Tage messe. Da die Anzahl der Meßwerte schwankt, zwischen 2950 und 3050, habe ich es nicht geschafft die Sortierspalte mittels Makro anzulegen.
Ich habe eine EcxelDatei angelegt so wie du gesagt hast.
die Rohdaten importiert
dann umgeordnet mit einem Makro das schon funktioniert ( ist nicht von mir, ich habe nur einige zeilen dazugebastelt)
und mit dem Diagrammassistent 2 Diagramme angelegt
und natürlich hochgeladen (Link ist unten)
mit den Diagrammen bin ich nicht zufrieden. Eine Woche auf eine Seite gepreßt ist zu viel. Entweder geht es gedehnt und zum scrollen (ich habs nicht geschafft) oder 2x 2Tage (288 Zeilen) und einmal den Rest, ist dann ca 3 Tage.
Die Beschriftung der Zeitachse müßte man nach unten aus dem Diagramm verschieben, die negativen Werte könnten auch noch größer sein und ev. gehts pro stunde eine Hilfslinie anzuzeigen.
Bitte um ausreichende Kommentare im Makro, vielleicht kann ich ja noch was lernen.
Gruß und schon mal vielen Dank
Hans
Hallo Reinhard,
bei Bandango ist es mir nicht gelungen testweise meine Datei runterzuladen, darum zur Sicherheit auch bei hostarea
http://www.hostarea.de/server-09/September-240df781d…
Gruß Hans
bei Bandango ist es mir nicht gelungen testweise meine Datei
runterzuladen, darum zur Sicherheit auch bei hostarea
http://www.hostarea.de/server-09/September-240df781d…
Hallo Hans,
ich hatte keine Schwierigkeiten bei badango.com.
Diagramme kommen später, erstmal die Datenaufbereitung.
So wie ich das deute, starteten deine messdaten (Rohdaten) am ersten Tag um 08:34:58 und enden am 8ten Tag um 10:53:26.
Drei Rohdatenzeilen ergeben dann später eine Zeile nach der Umsortierung. D.h. die Rohdaten haben 3042 Zeilen, die sortioerten nur noch 1014.
Ist das alles so korrekt?
Dann lasse mal den nachfolgenden Code übr deine Beispieldatei laufen.
Der Code ist noch nicht auf Schnelligkeit angelegt, unten links in der Statuszeile kannst du sehen wie er sich dahinschleppt.
Aber das ist jetzt nicht wichtig, wichtig ist nur daß die sortierte Liste das ist was du möchtest.
Gruß
Reinhard
Sub sortieren()
Dim Zei As Long, Anz As Long, T As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Worksheets("Roh").Delete
Application.DisplayAlerts = True
Worksheets("Rohdaten").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Roh"
With Worksheets("Roh")
Anz = Range("A" & Rows.Count).End(xlUp).Row
.Range("D2").Formula = "=(A2\>A1)\*1"
.Range("D2").Copy Destination:=Range("D2:smiley:" & Anz)
.Range("D" & Anz + 1).Formula = "=sum(D1:smiley:" & Anz & ")"
T = .Range("D" & Anz + 1)
Columns(4).ClearContents
.Range("D1") = T + 1
.Range("D2").Formula = "=if(a2\>A1,d1-1,d1)"
.Range("D2").Copy Destination:=Range("D2:smiley:" & Anz)
.Columns(4).Value = Columns(4).Value
.Range("A1:smiley:" & Anz).Sort Key1:=.Range("D1"), Order1:=xlAscending, Key2:=.Range("A1") \_
, Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:= \_
False, Orientation:=xlTopToBottom
For Zei = Anz To 3 Step -3
Application.StatusBar = Anz - Zei + 1 & " / " & Anz
.Cells(Zei, 4) = .Cells(Zei - 1, 3)
.Cells(Zei, 5) = .Cells(Zei - 2, 3)
.Rows(Zei - 1).Delete
.Rows(Zei - 2).Delete
Next Zei
.Columns(2).Delete
End With
Application.StatusBar = ""
Application.ScreenUpdating = True
End Sub
Hallo Reinhard,
So wie ich das deute, starteten deine messdaten (Rohdaten) am
ersten Tag um 08:34:58 und enden am 8ten Tag um 10:53:26.
Drei Rohdatenzeilen ergeben dann später eine Zeile nach der
Umsortierung. D.h. die Rohdaten haben 3042 Zeilen, die
sortioerten nur noch 1014.Ist das alles so korrekt?
Ja das stimmt so
Dann lasse mal den nachfolgenden Code übr deine Beispieldatei
laufen.
Der Code ist noch nicht auf Schnelligkeit angelegt, unten
links in der Statuszeile kannst du sehen wie er sich
dahinschleppt.
habe ich probiert, ist genau das Ergebnis das ich brauche,super.
zwei Kleinigkeiten die Zeile „Worksheets(„Roh“).Delete“ habe ich auskommentiert weil Fehlermeldung 9
Zum Namen des Tabellenblatts, Rohdaten habe ich das für dich zur Information genannt. die textdatei hat den Namen des Datums zb „011207“ , das möchte ich auch gerne beibehalten sonst verliere ich den Überblick, es sind ja viele Wochen wo gemessen wurde und wird.
Kannst du das bitte noch einbauen.
Vielen Dank für den ersten Teil, schaut vielversprechend aus
Gruß Hans
Hallo Hans,
zwei Kleinigkeiten die Zeile „Worksheets(„Roh“).Delete“ habe
ich auskommentiert weil Fehlermeldung 9
ja, der Fehler kommt, da du beim ersten Start des makros ja kein Blatt hast was „Roh“ heißt. Fiel mir beim Testen nicht auf, denn ich hatte immer vorher ein Blatt „Roh“. Aber keinerlei problem, ersetze
Application.DisplayAlerts = False
Worksheets(„Roh“).Delete
Application.DisplayAlerts = True
durch
Application.DisplayAlerts = False
For Zei = 1 To Worksheets.Count
If Worksheets(Zei).Name = "Roh" Then Worksheets(Zei).Delete
Next Zei
Application.DisplayAlerts = True
Zum Namen des Tabellenblatts, Rohdaten habe ich das für dich
zur Information genannt. die textdatei hat den Namen des
Datums zb „011207“ , das möchte ich auch gerne beibehalten
sonst verliere ich den Überblick, es sind ja viele Wochen wo
gemessen wurde und wird.
Kannst du das bitte noch einbauen.
Du müßtest nur
Worksheets(„Rohdaten“).Copy After:=Sheets(Sheets.Count)
abändern in
Worksheets(„011207“).Copy After:=Sheets(Sheets.Count)
das wäre dann statisch.
Dynamischer wäre es abzuändern in
activesheet.Copy After:=Sheets(Sheets.Count)
Allerdings mußt du dann dafür sorgen daß grad das gemeinte Blatt grad das Blatt ist was du siehst.
Wenn als gerade ein Diagrammblatt das aktive Blatt ist, so versagt der Code.
Wenn das Blatt was die Rohdaten enthält immer das erste oder zweite oder dritte Blatt ist, so ändere die Codezeile ab in:
Worksheets(2).Copy After:=Sheets(Sheets.Count)
für das zweite Blatt. leicht zu erkennen was zu tun ist um das dritte Blatt zu kopieren usw.
Eine Nachfrage noch, ist es garantiert daß immer drei Zeilen pro Messaufnahme kommen?
Wenn nicht muß man noch einbauen daß der Code am Anfang der Rohdatenliste und am Ende die Zeilen wegläßt, die nicht dem 3,2,1 Schema entsprechen. Ich hoffe du verstehst was ich meine.
Teste halt mal den Code nach den o.g. Änderungen, wenn dann alles klappt könnte man zu Diagrammen schreiten.
Gruß
Reinhard
Hallo Reinhard,
ja, der Fehler kommt, da du beim ersten Start des makros ja
kein Blatt hast was „Roh“ heißt. Fiel mir beim Testen nicht
auf, denn ich hatte immer vorher ein Blatt „Roh“. Aber
keinerlei problem, ersetzeApplication.DisplayAlerts = False
Worksheets(„Roh“).Delete
Application.DisplayAlerts = True
Ich werde diese Zeile weglassen, es wird nie ein Tabellenblatt „Roh“ geben. das einzige Blatt das existiert, nachdem ich die Werte importiert habe ist das mit den sog. Rohdaten und hat den Namen des Datums. Den möchte ich auch für das sortierte Blatt beibehalten. Ist es möglich einfach den Namen zu übernehmen mit einem Zusatz zB s für sortiert, sonst meckert er bei 2 gleichnamigen Blättern. Oder das erste einfach löschen, das brauche ich nicht mehr.
Dynamischer wäre es abzuändern in
activesheet.Copy After:=Sheets(Sheets.Count)
das habe ich eingebaut und funktioniert
Allerdings mußt du dann dafür sorgen daß grad das gemeinte
Blatt grad das Blatt ist was du siehst.Wenn als gerade ein Diagrammblatt das aktive Blatt ist, so
versagt der Code.
Wie gesagt, es ist das Einzige.
Eine Nachfrage noch, ist es garantiert daß immer drei Zeilen
pro Messaufnahme kommen?
Wenn nicht muß man noch einbauen daß der Code am Anfang der
Rohdatenliste und am Ende die Zeilen wegläßt, die nicht dem
3,2,1 Schema entsprechen. Ich hoffe du verstehst was ich
meine.
Bei dieser Meßreihe habe ich drei Meßstellen, also immer 3 werte pro Messung. Es wäre natürlich elegant wenn das Makro auch mit einer anderen Anzahl von meßstellen funktionieren würde. Da könnte ich auch bei Bedarf was ändern im Makro, wenn du mir sagst was.
Teste halt mal den Code nach den o.g. Änderungen, wenn dann
alles klappt könnte man zu Diagrammen schreiten.
Getestet ist soweit bis auf den tabellenblattnamen ok.
Eine Anmerkung zum Diagramm, eine Legende welcher wert welcher Meßstelle zuzuordnen ist wäre wichtig. ich habe die Information in der
erste Zeile der sortierten Daten drin (bei meiner Beispielmappe),also 3=außen 2=Mauer 1=innen
das wärs soweit
bis später Hans
Hallo Hans,
Ich werde diese Zeile weglassen, es wird nie ein Tabellenblatt
„Roh“ geben. das einzige Blatt das existiert, nachdem ich die
Werte importiert habe ist das mit den sog. Rohdaten und hat
den Namen des Datums.
„Roh“ dient(e) hauptsächlich zum Testen des Codes, würde man direkt in „Rohdaten“ rumsortieren und der Code läuft schräg, so wären ja die Originaldaten futsch.
Den möchte ich auch für das sortierte
Blatt beibehalten. Ist es möglich einfach den Namen zu
übernehmen mit einem Zusatz zB s für sortiert, sonst meckert
er bei 2 gleichnamigen Blättern. Oder das erste einfach
löschen, das brauche ich nicht mehr.
Diesmal „arbeitet“ der Code direkt in „Rohadten“. Das Blatt „tabelle1“ ist bei mir nur eine Kopie der Daten in „Rohdaten“.
Die auskommentierten Zeilen im Code dienen dazu, bei Tests, anfangs des Tests in „Rohdaten“ wieder den Originalzustand herzustellen.
Den aktuellen namen des Blattes kannst du oben in dieser Zeile festlegen/abändern:
Const wks As String = „Rohdaten“
Soll der name des gerade aktuellen Blattes genommen werden, so erstze diese Const-Zeile durch:
Dim wks as String
wks = activesheet.Name
In der Zeile
Const MR As Integer = 3
legst du die Anzahl an Messreihen pro Messaufnahme fest, kannst ja mal dort 3,6,9 usw. ausprobieren.
Wie gesagt, zum Testen ist es hilfreich du erstellst ein Hilfsblatt, bei mir war es „tabelle1“, dorthinein kopierst du deine Originaldaten, entfernst im Code die 4 Hochkommas, dann kannst du bequem mehrmals nacheinander testen.
Wenn alles klappt, kannst du die 4 Hochkommas wieder setzen, oder die 4 Zeilen löschen.
Um bequem testen zu können, klicke mal in Excel oben rechts neben das Fragezeichen mit rechter maustaste, dann auf „Anpassen“.
Oben klickst du auf „Befehle“, dann in der Liste „Makros“ auswählen, rechts siehst du dann „Schaltfläche anpassen“.
Das "ziehst du dir mit gedrückter linken Maustaste oben neben das Fragezeichen.
Dann Rechtsklick auf das neue Symbol, klicke auf „Makro zuweisen“ und weise das makro „Sortieren“ zu.
Wenn du den Makrocode in Modul1 der personl.xls schreibst, so steht dir das makro in allen Mappen zur Verfügung.
Wenn du keine personl.xls hast, so zeichne mit Extras–Makro–Aufzeichnen ein makro auf, anfangs im Fensterchen wählst du aus, speichern in persönlicher Arbeitsmappe.
Dann machst du irgendwas in Excel A1 nach b1 kopieren o.ä., ist egal und beendest die Aufzeichnung. Nun hast du eine personl.xls erstellt und in ihr existiert auch ein Modul1, wo du den Code reinschreiben kannst…
Wenn alles klappt, so würde ich dir vorschlagen, stelle hier bei w-w-w die Frage zu dem Diagramm als neuen Beitrag, da diese Beitragsfolge schon ziemlich lnag ist und kaum noch einer mitliest der dir beim Diagramm helfen könnte.
Gruß
Reinhard
Option Explicit
'
Sub sortieren()
Dim Zei As Long, Anz As Long, T As Integer, M As Integer, L As Range
Const wks As String = "Rohdaten"
Const MR As Integer = 3
Application.ScreenUpdating = False
With Worksheets(wks)
.Columns("A:H").Delete
.Columns("A:H").NumberFormat = "General"
Worksheets("Tabelle1").Columns(1).Copy Destination:=.Range("A1")
Worksheets("Tabelle1").Columns("B:C").Copy Destination:=.Range("B1")
Anz = .Range("A" & Rows.Count).End(xlUp).Row
Set L = Rows(Anz + 1)
.Range("D2").Formula = "=(A2\>A1)\*1"
.Range("D2").Copy Destination:=Range("D2:smiley:" & Anz)
.Range("D" & Anz + 1).Formula = "=sum(D1:smiley:" & Anz & ")"
T = .Range("D" & Anz + 1)
Columns(4).ClearContents
.Range("D1") = T + 1
.Range("D2").Formula = "=if(a2\>A1,d1-1,d1)"
.Range("D2").Copy Destination:=Range("D2:smiley:" & Anz)
.Columns(4).Value = Columns(4).Value
.Range("A1:smiley:" & Anz).Sort Key1:=.Range("D1"), Order1:=xlAscending, Key2:=.Range("A1") \_
, Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:= \_
False, Orientation:=xlTopToBottom
.Columns("A:A").Insert Shift:=xlToRight
.Columns("E:E").Copy Destination:=.Range("A1")
.Columns("E:E").Delete
.Columns("C:C").Delete
For Zei = Anz To MR Step -MR
Application.StatusBar = Anz - Zei + 1 & " / " & Anz
For M = 1 To MR - 1
.Cells(Zei, 3 + M) = .Cells(Zei - M, 3)
Next M
Set L = Union(Rows(Zei), L)
Next Zei
Worksheets.Add before:=Worksheets(wks)
L.Copy Destination:=ActiveSheet.Range("A1")
Application.DisplayAlerts = False
Worksheets("Rohdaten").Delete
Application.DisplayAlerts = True
ActiveSheet.Name = wks
End With
Application.StatusBar = ""
Application.ScreenUpdating = True
End Sub
Hallo Reinhard,
„Roh“ dient(e) hauptsächlich zum Testen des Codes, würde man
direkt in „Rohdaten“ rumsortieren und der Code läuft schräg,
so wären ja die Originaldaten futsch.
das macht natürlich Sinn
Diesmal „arbeitet“ der Code direkt in „Rohadten“. Das Blatt
„tabelle1“ ist bei mir nur eine Kopie der Daten in „Rohdaten“.
Die auskommentierten Zeilen im Code dienen dazu, bei Tests,
anfangs des Tests in „Rohdaten“ wieder den Originalzustand
herzustellen.
ich habe keine auskommentierten Zeilen gefunden
Den aktuellen namen des Blattes kannst du oben in dieser Zeile
festlegen/abändern:
Dim wks as String
wks = activesheet.Name
habe ich so gemacht
In der Zeile
Const MR As Integer = 3
legst du die Anzahl an Messreihen pro Messaufnahme fest,
kannst ja mal dort 3,6,9 usw. ausprobieren.
das finde ich 1A
Wenn du den Makrocode in Modul1 der personl.xls schreibst, so
steht dir das makro in allen Mappen zur Verfügung.Wenn du keine personl.xls hast, so zeichne mit
Extras–Makro–Aufzeichnen ein makro auf, anfangs im
Fensterchen wählst du aus, speichern in persönlicher
Arbeitsmappe.Dann machst du irgendwas in Excel A1 nach b1 kopieren o.ä.,
ist egal und beendest die Aufzeichnung. Nun hast du eine
personl.xls erstellt und in ihr existiert auch ein Modul1, wo
du den Code reinschreiben kannst…
das werde ich machen, das ist natürlich sehr hilfreich
Wenn alles klappt, so würde ich dir vorschlagen, stelle hier
bei w-w-w die Frage zu dem Diagramm als neuen Beitrag, da
diese Beitragsfolge schon ziemlich lnag ist und kaum noch
einer mitliest der dir beim Diagramm helfen könnte.
leider klappt es noch nicht ganz, ich habe diese 4 zeilen auskommentiert, weils mir die zu bearbeitende Tabelle gelöscht hat
'.Columns("A:H").Delete
'.Columns("A:H").NumberFormat = "General"
'Worksheets("Tabelle1").Columns(1).Copy Destination:=.Range("A1")
'Worksheets("Tabelle1").Columns("B:C").Copy Destination:=.Range("B1")
dann ist das Makro auch durchgelaufen, am Schluß blieb die Spalte A mit Ziffern von 1 bis 8 über.
Irgendwas habe ich warscheinlich nicht berücksichtigt mit den Tabellennamen, um den Code einigermaßen zu überblicken brauche ich ja vermutlich wochen.
Was habe ich falsch gemacht?
Gruß Hans
Hallo Hans,
Diesmal „arbeitet“ der Code direkt in „Rohadten“. Das Blatt
„tabelle1“ ist bei mir nur eine Kopie der Daten in „Rohdaten“.
Die auskommentierten Zeilen im Code dienen dazu, bei Tests,
anfangs des Tests in „Rohdaten“ wieder den Originalzustand
herzustellen.ich habe keine auskommentierten Zeilen gefunden
richtig, ich hatte vergessen sie auszukommentieren, aber du hast genau die 4 richtigen selbst gefunden 
leider klappt es noch nicht ganz, ich habe diese 4 zeilen
auskommentiert, weils mir die zu bearbeitende Tabelle gelöscht
hat
dann ist das Makro auch durchgelaufen, am Schluß blieb die
Spalte A mit Ziffern von 1 bis 8 über.
Nicht nachvollziehbar. Nachstehend ist anderer Code, probiere mal diesen aus.
Ist jetzt mehrfach auf den „Rohdaten“ die du mir gabst ausprobiert worden.
Gruß
Reinhard
Sub sortieren()
Dim Zei As Long, Anz As Long, T As Integer, M As Integer, L As Range
Dim wks As String, C, S, Z, B
wks = ActiveSheet.Name
Const MR As Integer = 3
Application.ScreenUpdating = False
With Worksheets(wks)
Anz = .Range("A" & Rows.Count).End(xlUp).Row
Set B = .Range("A1:A" & Anz)
For Z = 2 To Anz
If B.Cells(Z, 1) \> B.Cells(Z - 1, 1) Then T = T + 1
Next Z
.Columns("A:A").Insert
.Range("A1") = T + 1
.Range("A2").Formula = "=if(b2\>b1,a1-1,a1)"
.Range("A2").Copy Destination:=Range("A2:A" & Anz)
.Columns(1).Value = Columns(1).Value
.Range("A1:smiley:" & Anz).Sort Key1:=.Range("A1"), Order1:=xlAscending, Key2:=.Range("B1") \_
, Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:= \_
False, Orientation:=xlTopToBottom
.Columns("A:A").NumberFormat = "General"
.Columns("C:IV").NumberFormat = "General"
For Zei = Anz To MR Step -MR
Application.StatusBar = Anz - Zei + 1 & " / " & Anz
For M = 1 To MR - 1
.Cells(Zei, 4 + M) = .Cells(Zei - M, 4)
Next M
Next Zei
S = Split(.Cells(1, 3 + MR).Address, "$")
.Cells(1, 4 + MR).Formula = "=if(" & S(1) & "1"""",1,0)"
.Cells(1, 4 + MR).Copy Destination:=Range(Cells(1, 4 + MR), Cells(Anz, 4 + MR))
S = Split(.Cells(1, 4 + MR).Address, "$")
.Range("A1:" & S(1) & Anz).Sort Key1:=.Range(S(1) & "1"), \_
Order1:=xlDescending, Header:=xlNo, OrderCustom:=1, MatchCase:= \_
False, Orientation:=xlTopToBottom
Z = Application.WorksheetFunction.Match(0, .Range(S(1) & ":" & S(1)), 0)
.Range("A" & Z & ":" & S(1) & Anz).ClearContents
.Range(S(1) & 1).EntireColumn.Delete
.Columns(3).Delete
End With
Application.StatusBar = ""
Application.ScreenUpdating = True
End Sub
Vba Tabelle umkehren, Diagramm zeichnen
Hallo Hans,
dieser Code erstellt auch gleich das Diagramm mit:
Sub SortierenX()
Dim Anz As Long, Ber, Z As Long, ZZ As Long, B As Long
Const MR As Long = 3
Application.ScreenUpdating = False
With ActiveSheet
Anz = .Range("A" & Rows.Count).End(xlUp).Row
.Columns("D:smiley:").NumberFormat = "General"
.Range("D1") = 1
.Range("D2").Formula = "=IF(A2\>A1,D1+1,D1)"
.Range("D2").Copy Destination:=Range("D2:smiley:" & Anz)
.Columns(4).Value = .Columns(4).Value
.Columns("A:smiley:").Sort Key1:=.Range("D1"), Order1:=xlDescending, Key2:=.Range("A1") \_
, Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:= \_
False, Orientation:=xlTopToBottom
.Columns("D:smiley:").ClearContents
.Range("A1").Select
Ber = .Range(.Cells(1, 1), .Cells(Anz, 2 + MR))
For Z = MR To Anz Step MR
B = B + 1
For ZZ = 1 To MR - 1
Ber(Z, 3 + ZZ) = Ber(Z - ZZ, 3)
Next ZZ
For ZZ = 1 To 2 + MR
Ber(B, ZZ) = Ber(Z, ZZ)
Next ZZ
Next Z
.Range(.Cells(1, 1), .Cells(Anz, 2 + MR)) = Ber
.Columns(2).Delete
.Range(Cells(Int(Anz / MR) + 1, 1), Cells(Anz, 2 + MR)).ClearContents
Charts.Add
ActiveChart.ChartType = xlLine
ActiveChart.SetSourceData Source:=.Range(.Cells(1, 1), \_
.Cells(Int(Anz / MR), 1 + MR)), PlotBy:=xlColumns
ActiveChart.SeriesCollection(1).Name = "=""Außen"""
ActiveChart.SeriesCollection(2).Name = "=""Mauer Innen"""
ActiveChart.SeriesCollection(3).Name = "=""Innen"""
ActiveChart.Location Where:=xlLocationAsNewSheet
ActiveChart.HasTitle = True
ActiveChart.ChartTitle.Characters.Text = .Name
ActiveChart.Deselect
ActiveSheet.Name = "Diag" & .Name
.Activate
End With
Application.ScreenUpdating = True
End Sub
Gruß
Reinhard
Hallo Reinhard,
Diesmal „arbeitet“ der Code direkt in „Rohadten“. Das Blatt
„tabelle1“ ist bei mir nur eine Kopie der Daten in „Rohdaten“.
Die auskommentierten Zeilen im Code dienen dazu, bei Tests,
anfangs des Tests in „Rohdaten“ wieder den Originalzustand
herzustellen.
Wie gesagt, zum Testen ist es hilfreich du erstellst ein
Hilfsblatt, bei mir war es „tabelle1“, dorthinein kopierst du
deine Originaldaten, entfernst im Code die 4 Hochkommas, dann
kannst du bequem mehrmals nacheinander testen.
Ich habe jetzt nochmals getestet, vormittag war ich plötzlich im zeitdruck, habe vorerst im Code garnichts geändert, ein Blatt „Rohdaten“ angelegt und eine Kopie davon im Blatt „tabelle1“ .
das Ergebnis ist das gleiche, in der Spalte A ist diese Ziffernfoge 1 bis 8.
Übrigens hat das was mit der auskommentierung zu tun?
Option Explicit
'
Wenn nicht wozu ist das, im ersten wars nicht drin.
Gruß Hans
Hallo Reinhard,
mir scheint du bist ein Zauberer, du schüttelst den Code aus dem Ärmel.
das funktioniert wunderbar jetzt und geht so schnell daß ich schon glaubte es geht gar nicht. GRATULATION
wenn man das Diagramm noch etwas dehnen könnte wäre das noch das Extratüpferl.
danke und Gruß Hans
Hallo Hans,
das funktioniert wunderbar jetzt und geht so schnell daß ich
schon glaubte es geht gar nicht. GRATULATION
dankeschön.
wenn man das Diagramm noch etwas dehnen könnte wäre das noch
das Extratüpferl.
Was willst du da wie dehnen, es ist doch schon das Blatt auf Querformat, viel breiter geht da nicht aufs Blatt.
Wie gesagt, stelle am besten die Anfrage zum Diaramm neu oben ein.
Beschreibe was da wie gedehnt werden soll, kannst ja eine Beispielmappe mit dem durch den Code sortierten Daten und Diagramm hochladen.
Gruß
Reinhard