Wie du sehen kannst ignoriere ich Zeile 1.
Alle Daten ab A3 werden miteinbezogen, es gibt keine Beschränkung, so lange es keine leere Spalten oder leere Zeilen gibt zwischen den Daten.
Vorausgesetzt wid nur das jeder Gruppe 18 Zellen umfasst: Name, Code und 2001 bis 2016.
Vorausgesetzt wird auch dass die Spalte Identifikation zwischen (..) im 'Code' stehen.
Mehr gibt's nicht.
Erstmal nochmal danke für jede Mühe!
Zu später Stunde ist mir jetzt noch etwas aufgefallen. Ist es möglich, dass Name und Code jeweils für sich (natürlich wie gehabt im Verbund im 18er Block) eines Unternehmens immer auch in der gleichen Zeile stehen? Beispielsweise der Block H21 bis H38 und I21 bis I38. Hier wäre jetzt D:TIN neben D:SFQ-->nicht so gut;)
Ist es möglich, dass jedes Unternehmen in jeder Zeile "für sich" steht? Also beispielsweise Zeile 22 nur D:TIN, und in Zeile 40 nur D:SFQ.
Danke!
Zur Verdeutlichung lade ich noch ein Bild hoch:
Dateiupload bitte im Forum! So geht es: Klick mich!
PS: Mir fällt jetzt noch ein, man sortiert ja quasi die Blöcke zuerst nach Spalten (links/rechts), in einem zweiten Schritt bzw. zweiten Makro könnten in der gleichen Form die Blöcke dann nach Zeilen (oben/unten) sortiert werden, oder? Ist nur so eine Idee.
Wenn du etwas hochladen willst: bitte tue das hier ins Forum. Dann bleibt dies ein sinnvolle thread auch für spätere Besucher.
Was du fragst ist alles möglich.
Aber.... dieses Forum is zum helfen das selbt zu erstellen.
Ich fürchte das es in deiner Fall mehr ein 'Auftrag' sein würde als eine 'Hilfe'.
Uberlege ob es dann nicht besser wäre das als Auftrag zu sehen und jemand damit zu beschäftige den du dafür bezahlen könntest. (Es ist doch auch keine private Frage, meine ich).
Hallo,
Bis jetzt habe ich diesen Beitrag mitgelesen, und muss zugeben, dass der vba-Vorschlag meine Kenntnisse deutlich übersteigt. Interessant...
Aber bei der Struktur von Daten3.xls frage ich mich, ob es nicht einfacher wäre, eine Hilfszeile z.b. mit 1, 2, 3 usw so anzulegen, dass die Kurse dieselbe Zahl wie die Umsätze haben und dann ganz einfach mit den Funktionen des Menüs nach Spalten zu sortieren.
Dann stehen für eine Firma Aktienkurse und Umsätze direkt nebeneinander und könne danach weiter verarbeitet werden.
(Sorry, für solche effizienz bzw einfach-ist-besser posts)
(25.01.2016, 09:13)snb schrieb: [ -> ]Was du fragst ist alles möglich.
Aber.... dieses Forum is zum helfen das selbt zu erstellen.
Ich fürchte das es in deiner Fall mehr ein 'Auftrag' sein würde als eine 'Hilfe'.
Uberlege ob es dann nicht besser wäre das als Auftrag zu sehen und jemand damit zu beschäftige den du dafür bezahlen könntest. (Es ist doch auch keine private Frage, meine ich).
Es geht in diesem Fall um eine Auswertung für meinen Professor.. Und wenn es dann so geordnet ist wie beschrieben, könnte ich endlich damit weiter arbeiten-->Access-->SPSS-->Modell.
Ich ändere das Bild nachher, dass es hier im Forum bleibt!
Hier nochmal das Bild im Anhang:
Hallo Funkydonkey,
teste mal folgenden Code in einer Kopie Deiner Datei:
Code:
Option Explicit
Sub umverteilen()
Dim i As Long, j As Long
Dim lngZ As Long
Dim lngS As Long
Dim lngBlock As Long
Dim lngA As Long
lngZ = Cells(Rows.Count, 1).End(xlUp).Row
lngS = Cells(1, Columns.Count).End(xlToLeft).Column
lngBlock = 2016 - 2001 + 3
Application.ScreenUpdating = False
On Error Resume Next
For i = 4 To lngZ Step lngBlock
For j = 2 To lngS
If Cells(i, j) <> "" And Not IsError(Cells(1, j)) Then
If Replace(Split(Cells(i, j), "(")(1), ")", "") <> Cells(1, j) Then
lngA = Application.WorksheetFunction.Match(Replace(Split(Cells(i, j), "(")(1), ")", ""), Rows(1), 0)
With Range(Cells(i - 1, j), Cells(i + lngBlock - 2, j))
.Copy Range(Cells(i - 1, lngA), Cells(i + lngBlock - 2, lngA))
.Value = "#NA"
.Interior.ColorIndex = 6 'Farbsetzung; diese Zeile kann bei nicht gebrauch gelöscht werden
Range(Cells(i - 1, lngA), Cells(i + lngBlock - 2, lngA)).Interior.ColorIndex = 6 'Farbsetzung; diese Zeile kann bei nicht gebrauch gelöscht werden
End With
End If
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub
Ich färbe die Blöcke, die verschoben werden gelb, damit Du besser vergleichen kannst.
Die Zeilen, die die Blöcke färben sind im Code durch Kommentare kenntlich.
Da nicht alle Blöcke eingelesen werden und keine neue Tabelle eingefügt wird, ist der Code trotz Farbsetzung schneller als die Variante von snb.
Beachte, dass ich auch bei falscher Begung auch in die Überschriftzeile ein "#NA" reinschreibe.
Wenn da etwas anderes stehen soll, dann melde Dich.
Genial!:) Vielen Dank für deine tolle Lösung. In den letzten Stunden habe ich mich mit VBA beschäftigt und habe immerhin schon die ersten paar Zeilen von SNBs Code verstanden. :21:
Ich hoffe, jetzt kann ich die Daten "weiterverarbeiten" und muss mich erstmal nicht mehr an euch wenden:)
PS: Wie viele Monate/Jahre muss man sich mit VBA beschäftigen, um so was zu vollbringen?
Hallo Funkydonky,
folgende Zeile im Code muss gelöscht werden:
Code:
On Error Resume Next
Ich hatte diese beim Testen genutzt, da es durch Fehlferte in der Zeile 1 zu Fehlern kam und ich aber erst mal sehen wollte,
ob sonst der Code richtig arbeitet.
Unten stelle ich einen leicht erweiterten Code ein. Da werden eventuelle Fehler abgefangen.
Blöcke, die vom Code aus irgendeinem Grund nicht verarbeitet werden können, werden rot markiert.
Soweit ich gesehen habe wurde aber in der zuletzt eingestellten Datei alles verarbeitet
Code:
Option Explicit
Sub ordnen()
Dim i As Long, j As Long
Dim lngZ As Long
Dim lngS As Long
Dim lngBlock As Long
Dim lngA
lngZ = Cells(Rows.Count, 1).End(xlUp).Row
lngS = Cells(1, Columns.Count).End(xlToLeft).Column
lngBlock = 2016 - 2001 + 3
Application.ScreenUpdating = False
For i = 4 To lngZ Step lngBlock
For j = 2 To lngS
If Cells(i, j) <> "" And Not IsError(Cells(1, j)) Then
If Replace(Split(Cells(i, j), "(")(1), ")", "") <> Cells(1, j) Then
lngA = Application.Match(Replace(Split(Cells(i, j), "(")(1), ")", ""), Rows(1), 0)
With Range(Cells(i - 1, j), Cells(i + lngBlock - 2, j))
If IsNumeric(lngA) Then
.Copy Range(Cells(i - 1, lngA), Cells(i + lngBlock - 2, lngA))
.Value = "#NA"
.Interior.ColorIndex = 6 'Farbsetzung; diese Zeile kann bei nicht gebrauch gelöscht werden
Range(Cells(i - 1, lngA), Cells(i + lngBlock - 2, lngA)).Interior.ColorIndex = 6 'Farbsetzung; diese Zeile kann bei nicht gebrauch gelöscht werden
Else
.Interior.ColorIndex = 3 'Blöcke die nicht verarbeitet werden können werden rot markiert
End If
End With
End If
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub