Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 00:42:03
Listbox mit gefilterten Daten füllen
24.04.2024 20:38:58
Summe mit Bedingung, nur letzte Ergebnisse anzeigen
24.04.2024 19:29:30
Formel filter
24.04.2024 18:49:56
merge & select
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1612to1616
1612to1616
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Anschlussfrage Formatierung bei arr()

Anschlussfrage Formatierung bei arr()
19.03.2018 07:57:36
Gregor
Hallo zusammen
Ich habe von Rudi einen Code erhalten und diesen in mein Makro eingebaut. Funktioniert bestens, nur möchte ich auch die Zellformatierung übertragen. Ist das mit arr() möglich und wenn ja wie? Oder geht das nur mit copypaste, was eben sehr langsam ist.
For z = 1 To lastRow - 1
With Sheets(Blattname)
lSpalte = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
Zeile_Hin = .Application.Match("DC Hinfahrt", .Columns(1), 0)
Zeile_Rück = .Application.Match("DC Rückfahrt", .Columns(1), 0)
lZeile = .Cells(.Cells(Zeile_Rück, 1).End(xlUp).Row + 1, 1).Row
arrIn = .Range(.Cells(Zeile_Hin, 1), .Cells(lZeile - 1, lSpalte))
ReDim arrOut(1 To UBound(arrIn), 1 To Application.CountIf(.Rows(Zeile_Hin), arrBlatt(z)) + 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) = arrBlatt(z) Then
k = k + 1
For i = 1 To UBound(arrIn)
arrOut(i, k) = arrIn(i, j)
Next
End If
Next j
With Worksheets("DC " & arrBlatt(z))
.Cells.ClearContents
.Cells.ClearFormats
.Cells(1, 1).Resize(UBound(arrOut), UBound(arrOut, 2)) = arrOut
End With
Next z
Danke und Gruss
Gregor

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Anschlussfrage Formatierung bei arr()
19.03.2018 08:26:21
ChrisL
Hi Gregor
Array/Datenfelder haben keine (Zell-)Formatierung.
cu
Chris
AW: Anschlussfrage Formatierung bei arr()
19.03.2018 13:05:34
Gregor
Hoi Chris
Danke für die Klärung. Gibt es tatsächlich keine Alternative zu copypaste oder wie kriege ich die Formatierung auch mit?
Danke und Gruss
Gregor
AW: Anschlussfrage Formatierung bei arr()
19.03.2018 13:28:39
Daniel
Hi
du kannst ja die Inhalte wie bisher mit deinem Array übertragen und hinterher die Formatierungen mit 
Quelle.Copy
Ziel.PasteSpecial xlpasteformats

vom Quellbereich zum Zielbereich übertragen.
Gruß Daniel
AW: Anschlussfrage Formatierung bei arr()
19.03.2018 14:29:44
Gregor
Hallo Daniel
Das tönt einfach, aber die Quelle sind ja einzelne Zellen die gesucht und dann mit Array übertragen werden (siehe Code). Wie definiere ich denn hinterher Quelle und Ziel.
Danke und Gruss
Gregor
Anzeige
AW: Anschlussfrage Formatierung bei arr()
20.03.2018 08:29:57
Daniel
Hi
Ziel ist der Zellbereich, in den du das Array einfügst. Es reicht die linke obere Zelle.
Quelle wird etwas schwieriger, wenn du nicht einen kompletten Zellblock ins Array übernimmst.
Hier müsstet du eine Range-Variable erstellen und jede Zeile, die auch uns Array kommt, mit UNION zu dieser Variable hinzufügen.
Sieht im Prinzip so aus
for z = 2 to 100
If Bedingung erfüllt Then
Hier der Code um das Array mit den
Werten aus Zeile z zu füllen
If rngQuelle is Nothing Then
Set rngQuelle = Rows(z)
Else
Set rngQuelle = Union(rngQuelle, rows(z))
Ende If
Ende If
Next
Cells(x, y).Resize(Arraygröße).value = Array
rngQuelle.copy
Cells(x, y).PasteSpecial xlpasteFormats
Gruß Daniel
Anzeige
AW: Anschlussfrage Formatierung bei arr()
20.03.2018 11:41:12
Gregor
Hallo Daniel
Ich habe deinen Code in meinen Code eingebaut (einmal bei for i und einmal bei for j) sowie Dim rngQuelle (welcher Typ?). Dann rngQuelle.Copy und Cells(1, 1).PasteSpecial xlPasteFormats. Siehe mein Code.
Ich erhalte jedoch eine Fehlermeldung, vermutlich ist die Übernahme in meinem Code nicht korrekt. Ich bin dir sehr dankbar, wenn du mich nochmals unterstützen kannst.
For z = 1 To lastRow - 1
With Sheets(Blattname)
lSpalte = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
Zeile_Hin = .Application.Match("DC Hinfahrt", .Columns(1), 0)
Zeile_Rück = .Application.Match("DC Rückfahrt", .Columns(1), 0)
lZeile = .Cells(.Cells(Zeile_Rück, 1).End(xlUp).Row + 1, 1).Row
arrIn = .Range(.Cells(Zeile_Hin, 1), .Cells(lZeile - 1, lSpalte))
ReDim arrOut(1 To UBound(arrIn), 1 To Application.CountIf(.Rows(Zeile_Hin), arrBlatt(z)) + 1)
End With
For i = 1 To UBound(arrIn)
arrOut(i, 1) = arrIn(i, 1)
If rngQuelle Is Nothing Then
Set rngQuelle = Rows(i)
Else
Set rngQuelle = Union(rngQuelle, Rows(i))
End If
Next i
k = 1
For j = 2 To UBound(arrIn, 2)
If arrIn(1, j) = arrBlatt(z) Then
k = k + 1
For i = 1 To UBound(arrIn)
arrOut(i, k) = arrIn(i, j)
If rngQuelle Is Nothing Then
Set rngQuelle = Rows(j)
Else
Set rngQuelle = Union(rngQuelle, Rows(j))
End If
Next
End If
Next j
rngQuelle.Copy
With Worksheets("DC " & arrBlatt(z))
.Cells.ClearContents
.Cells.ClearFormats
.Cells(1, 1).Resize(UBound(arrOut), UBound(arrOut, 2)) = arrOut
Cells(1, 1).PasteSpecial xlPasteFormats
End With
Next z
Danke und Gruss
Anzeige
AW: Anschlussfrage Formatierung bei arr()
20.03.2018 12:41:52
Daniel
Hi
1. copy und Paste sollten direkt bei einander liegen.
es gibt Aktionen, bei denen der Kopierspeicher geleert wird und wenn man die zwischen Copy und Paste ausführt, weiß Excel ja nicht, was es einfügen soll.
2. hier fehlt der Punkt: Cells(1, 1).PasteSpecial xlPasteFormats
damit werden die kopierten Formate nicht in den Zellbereich eingefügt, den du bei WITH beschrieben hast, sondern auf dem aktiven Tabellenblatt in die Zelle A1
3. auch bei Rows(z) musst du das Tabellenblatt mit angeben, denn du willst ja nicht die Formate vom aktiven Blatt kopieren, sondern vom dem Blatt, von dem du die Werte ins Ausgangsarray arrIn eingelesen hast.
4. bei rows(z) brauchst du als Zeilennummer die absolute Zeilennummer auf dem Tabellenblatt.
da du aber das Array arrIn nicht ab Zeile 1 eingelesen hast, hast du einen Versatz zwischen Array-Zeile und dazugehöriger Tabellenblattzeile. den musst du mit berücksichtigen:
Zeile für Row = ArrayZeilenZähler + Zeile_Hin - 1
5. kann es sein, dass du bei Rows den Spaltenzähler verwendest (j)
das passt natürlich gar nicht.
noch ein paar allgemeine Hinweise:
- wenn du Code hier einstellst, markiere ihn und klicke den Code-Button.
dann bleiben die Einrückungen erhalten und der Text wird in Courier dargestellt, damit wird er leichter lesbar
- lade möglichst eine Beispieldatei mit hoch, die den Code und die Daten enthält und mit der man das ganze ausprobieren kann.
Gruß Daniel
Anzeige
AW: Anschlussfrage Formatierung bei arr()
21.03.2018 09:50:37
Gregor
Hallo Daniel
Danke für die Erläuterungen und die Tipps. Ich versuchte diese umzusetzen, das ganze ist jedoch nicht ganz einfach, ich erhalte bereits bei If rngQuelle Is Nothing Then eine Fehlermeldung. Ich erlaube mir deshalb, dir eine Testdatei hochzuladen. Ziel ist, neben den Werten auch die Formatierung in die Code-Blätter zu übertragen.
Ohne die Formatierung (hier ausgeklammert) läuft der Code einwandfrei. Die Originaldatei erfodert viele Überträge, weshalb ein Array viel schneller läuft.
https://www.herber.de/bbs/user/120554.xlsm 
Sub Übertragen()
Dim arrOut(), arrIn
Dim i As Long, j As Long, k As Long
Dim arrBlatt(20)
Dim lZeile_Copy
Dim rngQuelle
Application.ScreenUpdating = False
lastRow = Worksheets("Master").Cells(Rows.Count, 1).End(xlUp).Row
Blattname = Worksheets(1).Name
For i = 2 To lastRow
arrBlatt(i - 1) = Worksheets("Master").Cells(i, "A")
Next i
For z = 1 To lastRow - 1
With Sheets(Blattname)
lSpalte = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
lZeile = .Cells(.Cells(Zeile_Rück, 1).End(xlUp).Row + 1, 1).Row
arrIn = .Range(.Cells(Zeile_Hin, 1), .Cells(lZeile - 1, lSpalte))
ReDim arrOut(1 To UBound(arrIn), 1 To Application.CountIf(.Rows(Zeile_Hin),  _
arrBlatt(z)) + 1)
End With
For i = 1 To UBound(arrIn)
arrOut(i, 1) = arrIn(i, 1)
'            If rngQuelle Is Nothing Then
'                Set rngQuelle = Worksheets(Blattname).Rows(i)
'            Else
'                Set rngQuelle = Union(rngQuelle, Worksheets(Blattname).Rows(i))
'            End If
'            rngQuelle.Copy
'            Worksheets(Blattname).Cells(1, 1).PasteSpecial xlPasteFormats
Next i
k = 1
For j = 2 To UBound(arrIn, 2)
If arrIn(1, j) = arrBlatt(z) Then
k = k + 1
For i = 1 To UBound(arrIn)
arrOut(i, k) = arrIn(i, j)
'                    If rngQuelle Is Nothing Then
'                        Set rngQuelle = Worksheets(Blattname).Rows(j)
'                    Else
'                        Set rngQuelle = Union(rngQuelle, Worksheets(Blattname).Rows(j))
'                    End If
'                    rngQuelle.Copy
'                    Worksheets(Blattname).Cells(1, 1).PasteSpecial xlPasteFormats
Next i
End If
Next j
With Worksheets("DC " & arrBlatt(z))
.Cells.ClearContents
.Cells.ClearFormats
.Cells(1, 1).Resize(UBound(arrOut), UBound(arrOut, 2)) = arrOut
End With
Next z
End Sub
Kannst du mir den Code KORREKT ergänzen?
Vielen Dank und Gruss
Gregor
Anzeige
ganz anderer Ansatz
21.03.2018 11:26:29
Daniel
Hi
die Aufgabe lässt sich so einfacher und schneller lösen:
1. sortiere die Tabelle "Alle Codes" nach Zeile 9. Hierzu in den Sortieroptionen "Spalten sortieren" anwählen
2. suche mit .FIND die erste und letzte Spalte mit dem jeweiligen Code.
dies steuerst du über den Parameter SearchDirection:=xlNext / xlPrevious
3. kopiere dann den Bereich zwischen diesen beiden Zellen in die neue Tabelle.
reicht dir diese Beschreibung um damit neuen Code zu erstellen?
Gruß Daniel
AW: ganz anderer Ansatz
21.03.2018 17:03:46
Gregor
Hallo Daniel
Besten Dank. Ich habe den Code nun nach deinem Vorschlag aufgebaut und es funktiert bis auf eine Fehlermeldung bei der zweiten On Error GoTo weiterRück
On Error GoTo weiterHin
Spalte_copy1 = .Rows(Zeile_Hin).Find(What:=arrBlatt(y), LookAt:=xlWhole,  _
SearchDirection:=xlNext).Column
Spalte_copy2 = .Rows(Zeile_Hin).Find(What:=arrBlatt(y), LookAt:=xlWhole, SearchDirection:=xlPrevious).Column
Die Sprungmarken weiterHin: und weiterRück: habe ich definiert.
Fehlermeldung bei On Error GoTo weiterRück
Objektvariable oder With-Blockvariable nicht festgelegt.
OnError GoTo weiterHin funktioniert.
Woran liegt das?
Danke und Gruss
Gregor
Anzeige
AW: ganz anderer Ansatz
21.03.2018 18:20:24
Daniel
Hi
das liegt an deiner Programmierung.
Das Problem ist, dass nach so einem Sprung der Fehlerbehandlungmodus aktiv ist.
Im Fehlerbehandlungsmodus selbst sind keine weitern Fehlersprünge mehr möglich.
Der Fehlerbehandlungsmodus müsste dazu erst mit Resume aufgehoben werden.
On Error Goto-Sprünge braucht man hier nicht.
wenn man mit .Find arbeitet, dann weist man die Fundstelle einer Range-Variable zu.
Das gibt keinen Fehler, wenn der Suchbegriff nicht gefunden wird, sondern die Rangevariable bleibt leer und das kann man abfragen.
dim Zelle1 as Range
dim Zelle2 as Range
dim Spalte_Copy1 as long
dim Spalte_Copy2 as long
set Zelle1 = .Rows(Zeile_Hin).Find(What:=arrBlatt(y), LookAt:=xlWhole, SearchDirection:=xlNext)
if not Zelle1 is nothing then
Set Zelle2 = .Rows(Zeile_Hin).Find(What:=arrBlatt(y), LookAt:=xlWhole, SearchDirection:= _
xlPrevious)
Spalte_Copy1 = Zelle1.Column
Spalte_Copy2 = Zelle2.Column
usw.
end if
Gruß Daniel
Anzeige
AW: ganz anderer Ansatz
22.03.2018 08:11:00
Gregor
Hallo Daniel
Auch diesen Makel konnte ich Dank deiner Hilfe noch eliminieren. Nochmals vielen Dank für deine wertvolle Unterstützung.
Gruss Gregor

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige