Matrix in Vektor ohne Leerzellen

[Insenboy]

Hallo liebes Forum,

ich würde gerne eine Matrix in einen Vektor umwandeln. Dafür habe ich auch schon viele gute Makro- und Formel-Lösungen im Internet gefunden. Das Problem ist für mich dabei, dass die Matrix Leerzellen hat und der Vektor aber ohne Leerzellen sein soll (siehe
  Matrix.xlsx (Größe: 10,36 KB / Downloads: 3) ). Dafür habe ich bisher keine Lösung im Internet gefunden. Daher habe ich folgenden Code geschrieben:

Code:

Sub MatrixinVektorohneleer()
Dim i As Long, h As Long, d As Long
i = 7
For d = 2 To 8
h = 3
Do
If ThisWorkbook.Sheets("Matrix").Cells(d, h) = "" Then
h = h + 1
Else
ThisWorkbook.Sheets("Vektor").Cells(i, 3) = ThisWorkbook.Sheets("Matrix").Cells(d, h)
h = h + 1
i = i + 1
End If
Loop While h <= 12
Next d
End Sub

In der angehängten Beispieldatei 
  Matrix.xlsx (Größe: 10,36 KB / Downloads: 3) ist das auch kein Problem. Als ich dann aber den Code auf meine eigentliche Datenbasis angewendet habe, habe ich gemerkt, dass die Schleifen für eine 365 x 100 Matrix nicht so gut geeignet sind (ca. 5 Minuten Rechendauer)...
Kennt jemand eine Methode, die meine Anforderung lösen kann und etwas weniger rechenaufwendig ist?

Viele Grüße
Insenboy

[Elex]

Hi

Versuch mal den Code. Er kommt in das Modul Matrix.

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Bereich As Range, i As Long

On Error Resume Next
Application.ScreenUpdating = False
Set Bereich = Range("C2:L8")
With Sheets("Vektor")
.Range("C7", .Range("C7").End(xlDown)).Clear
For i = 1 To Bereich.Rows.Count
  Bereich.Rows(i).SpecialCells(xlCellTypeConstants).Copy
  .Range("C" & .Cells(.Rows.Count, 3).End(xlUp).Row + 1).PasteSpecial xlPasteValues, Transpose:=True
  Application.CutCopyMode = False
Next i
End With

Application.ScreenUpdating = True
Cancel = True
End Sub

Gruß Elex

[Insenboy]

Hi Elex,
vielen Dank für die schnelle Hilfe!
Der Code ist auf jedenfall viel besser als meiner, es dauert ungefähr 1 Minute für die 365 x 100 Matrix. Vielen Dank dafür!
Kann das irgendwer noch schneller? :D Es geht nämlich darum, dass diese Umrechnung immer wieder gemacht werden muss, wenn ein anderer Datensatz in dem gleichen Matrixformat eingelesen wird und da ist 1 Minute immer noch recht lang. Ich bin kein Excel Pro, vielleicht geht es ja bei dieser Datendimension auch nicht viel schneller!?

[Elex]

Hi

Für 365 x 100 benötigt er bei mir nur 3s-15s je nach Anzahl Leerzellen.

Kannst du eine originalere Bsp Datei zur Verfügung stellen.

Gruß Elex

[Insenboy]

Hi Elex,

anbei die Beispieldatei
  Matrixgroß.xlsx (Größe: 489,81 KB / Downloads: 5) . Im Blatt "Matrix" sind die Beispieldaten. Die Ergebnisse im Blatt "Vektor" sind mit dem folgenden Code produziert:

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Bereich As Range, i As Long

On Error Resume Next
Application.ScreenUpdating = False
Set Bereich = Range("C2:CX366")
With Sheets("Vektor")
.Range("C7:C" & .Cells(.Rows.Count, 3).End(xlUp).Row).Clear
For i = 1 To Bereich.Rows.Count
 Bereich.Rows(i).SpecialCells(xlCellTypeConstants).Copy
 .Range("C" & .Cells(.Rows.Count, 3).End(xlUp).Row + 1).PasteSpecial xlPasteValues, Transpose:=True
Next i
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
Cancel = True
End Sub

Was bei mir außerdem passiert ist, dass die ersten Einträge im Blatt "Vektor" in Zelle C2 anfangen und nicht in C7.
Danke für deine Mühe.

[Elex]

Hi

Also der Code aus #5 läuft bei mir in deiner Bsp Datei aus #5 in 3s durch.

Was bei mir außerdem passiert ist, dass die ersten Einträge im Blatt "Vektor" in Zelle C2 anfangen und nicht in C7.

Das habe ich im folgenden Code angepasst.
Evtl. finden in deiner Original Datei während der Codeausführung noch Berechnungen statt.
Versuche es mal mit dem Code.

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Bereich As Range, i As Long

On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlManual

Set Bereich = Range("C2:CX366")
With Sheets("Vektor")
.Range("C7", .Range("C7").End(xlDown)).Clear
For i = 1 To Bereich.Rows.Count
  Bereich.Rows(i).SpecialCells(xlCellTypeConstants).Copy
  .Range("C" & .Cells(.Rows.Count, 3).End(xlUp).Row + 1).PasteSpecial xlPasteValues, Transpose:=True
  Application.CutCopyMode = False
Next i
End With

Application.EnableEvents = True
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
Cancel = True
End Sub

Gruß Elex

[Insenboy]

Hi Elex,

sehr cool, jetzt geht's in ~ 6s. Ist mein Rechner wohl ein bisschen langsamer als deiner ;)

Mhh, da sind nen paar Datenbankabfragen in der Datei, könnte sein dass die irgendwas durcheinander bringen oder sich gleichzeitig aktualisieren wollen. Da schau ich nochmal.

Und dass die Daten ab C2 runtergeschrieben sind ist auch nicht so schlimm, da kann ich die Datei anpassen.

Vielen Dank für deine Hilfe und Zeit!

Viele Grüße
Insenboy

[LCohen]

Oft kann man durch Behandlung im Variantarray noch etwas zeitlich verkürzen. Da aber Elex mit Bordmitteln transponiert, wäre der Aufwand hier wohl zu hoch.

[snb]

Blitzschnell:

PHP-Code:

Sub M_snb()
  sn = Tabelle1.Cells(2, 3).CurrentRegion
    
  ReDim sp(UBound(sn) * UBound(sn, 2), 0)
    
  For Each it In sn
    If it <> "" Then
      sp(j, 0) = it
      j = j + 1
    End If
  Next
    
  Tabelle2.Cells(1, 6).Resize(UBound(sp)) = sp
End Sub