Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1612to1616
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

array füllen und zurückgeben

array füllen und zurückgeben
12.03.2018 11:31:48
Gregor
Hallo
Dieser Code mit copypaste läuft sehr langsam:
Blattname = Worksheets(1).Name
lastRow = Worksheets("Master").Cells(Rows.Count, 1).End(xlUp).Row
With Worksheets(Blattname)
.Select
lSpalte = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
Zeile_Hin = Application.Match("DC Hinfahrt", .Columns(1), 0)
Zeile_Rück = Application.Match("DC Rückfahrt", .Columns(1), 0)
For y = 1 To lastRow - 1
lZeile = .Cells(Cells(Zeile_Rück, 1).End(xlUp).Row + 1, 1).Row
Spalte = 0
Zähler = 1
With Worksheets("DC " & arrBlatt(y)).Rows.EntireRow
.ClearContents 'löscht die Inhalte, bzw. Formeln
.ClearFormats 'löscht die Formate
End With
Worksheets(Blattname).Range(Cells(Zeile_Hin, 1), Cells(lZeile, 1)).Copy Worksheets("DC " & arrBlatt(y)).Cells(1, Zähler)
For Start = 1 To lSpalte
Spalte_Copy = Application.Match(arrBlatt(y), .Range(.Cells(Zeile_Hin, Start), .Cells(Zeile_Hin, lSpalte)), 0)
If IsError(Spalte_Copy) Then GoTo weiter
Start = Start + Spalte_Copy - 1
Spalte = Spalte + Spalte_Copy
Zähler = Zähler + 1
Worksheets(sTxt).Range(Cells(Zeile_Hin, Spalte), Cells(lZeile - 1, Spalte)).Copy
With Sheets("DC " & arrBlatt(y))
.Cells(1, Zähler).PasteSpecial Paste:=xlPasteColumnWidths
.Cells(1, Zähler).PasteSpecial Paste:=xlPasteFormats
.Cells(1, Zähler).PasteSpecial Paste:=xlPasteValues
End With
Next Start
weiter:
Statt mit copypaste versuche ich es mit folgendem Array, der Array bleibt jedoch leer. Wie kann ich diese füllen und zurückschreiben?
Beispiel
Sub meinArray()
Dim myArr(1 To 44, 1 To 7) As Variant
Dim myRow As Long
Dim myCol As Integer
Blattname = Worksheets(1).Name
myRow = 1 'Startzeile
myCol = 1 'Startspalte
'Array füllen
For Start = 1 To 7
myArr(1, Start) = Sheets(Blattname).Range(Cells(9, Start), Cells(52, Start)) 'Array fü _
llen
Next
'Array zurückschreiben
With Sheets("DC 1132")
.Range(.Cells(myRow, myCol), _
.Cells(myRow + UBound(myArr, 1) - 1, myCol + UBound(myArr, 2) - 1)) = myArr()
End With
End Sub

Danke und Gruss
Gregor

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: array füllen und zurückgeben
12.03.2018 12:02:05
Rudi
Hallo,
so geht das:
Sub meinArray()
Dim myArr As Variant
myArr = Worksheets(1).Cells(9, 1).Resize(44, 7)
Sheets("DC 1132").Cells(1, 1).Resize(UBound(myArr), UBound(myArr, 2)) = myArr
End Sub

Gruß
Rudi
AW: array füllen und zurückgeben
12.03.2018 13:19:08
Gregor
Hallo Rudi
Danke.
Die zu kopierenden Spalten sind jedoch nicht zusammenhängend und müssen in einem Loop gesucht und kopiert werden.
So muss zB. in Zeile 9 Code 1132 gesucht werden, anschliessend diese Spalte kopieren und in Array einlesen usw. Nach dem Loop in Blatt "DC 1132" alles ab Zelle A1 einfügen.
Zum besseren Verständnis siehe Musterdatei, Blatt DC 3211.
https://www.herber.de/bbs/user/120358.xlsx
Worksheets(Blattname).Range(Cells(Zeile_Hin, 1), Cells(lZeile, 1)).Copy Worksheets("DC " & arrBlatt(y)).Cells(1, Zähler)
For Start = 1 To lSpalte
Spalte_Copy = Application.Match(arrBlatt(y), .Range(.Cells(Zeile_Hin, Start), .Cells(Zeile_Hin, lSpalte)), 0)
If IsError(Spalte_Copy) Then GoTo weiter
Start = Start + Spalte_Copy - 1
Spalte = Spalte + Spalte_Copy
Zähler = Zähler + 1
Worksheets(sTxt).Range(Cells(Zeile_Hin, Spalte), Cells(lZeile - 1, Spalte)).Copy
Vielen Dank
Gregor
Anzeige
AW: array füllen und zurückgeben
13.03.2018 14:34:35
Gregor
Hallo Rudi
Kannst du mir nochmals weiterhelfen, siehe Details und Musterdatei vom 12.03.2018.
Vielen Dank
Gregor
AW: Array füllen und zurückgeben
13.03.2018 15:40:08
Rudi
Hallo,
teste mal:
Sub aaaa()
Dim arrOut(), arrIn
Dim i As Long, j As Long, k As Long
Dim vntMatch
vntMatch = --Right(ActiveSheet.Name, 4)
Application.ScreenUpdating = False
With Sheets("Quelldatei")
arrIn = .Cells(9, 1).CurrentRegion
ReDim arrOut(1 To UBound(arrIn), 1 To Application.CountIf(.Rows(9), vntMatch) + 1)
End With
For i = 1 To UBound(arrIn)
arrOut(i, 1) = arrIn(i, 1)
Next i
k = 1
For j = 2 To UBound(arrIn, 2)
If arrIn(1, j) = vntMatch Then
k = k + 1
For i = 1 To UBound(arrIn)
arrOut(i, k) = arrIn(i, j)
Next
End If
Next j
With ActiveSheet
.Cells.ClearContents
.Cells(1, 1).Resize(UBound(arrOut), UBound(arrOut, 2)) = arrOut
End With
End Sub

Gruß
Rudi
Anzeige
AW: Array füllen und zurückgeben
14.03.2018 13:37:18
Gregor
Hallo Rudi
Ich habe deinen Code in mein Makro eingebaut, er funktioniert und läuft viel schneller als copypaste. Einziger Makel, die Originaldatei hat Formatierungen und diese werden nicht mitgenommen, was jedoch gewünscht wird. Vermutlich ist das mit arr nicht möglich. Oder gibt es doch eine Möglichkeit?
Vielen Dank und Gruss
Gregor

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige