Office: In Excel per VBA Range durchsuchen, Zellinhalt in anderes Tabellenblatt übertragen

Ullitheheck · 6. August 2013

Moin alle zusammen,

habe ein großes Problem. Ich muss zurzeit eine sehr große Datenbank mit VBA aufbauen, allerdings habe ich bisher noch nicht allzu viel Kenntnis davon.
Vielleicht kann mir hier jemand helfen. Ich wäre für jede Hilfe extrem dankbar.

Das Problem stellt sich wie folgt dar: ich habe eine riesige Quelltabelle/Tabellenblatt mit ca. 20000 Zeilen und ca. 60 Spalten.
Die ersten 6 Spalten, die gewissse allgemeine Informationen enthalten (Namen, Codes, Nummern, etc.) und zusätzliche 52 Spalten (Die Wochen des Jahres). Die Zellen dieser 52 Spalten sind teilweise leer und verfügen teilweise über Einträge.

Ziel ist es, den Wochenbereich (52 x 20000 Zellen) mit einem Makro schrittweise durchsuchen zu lassen (bei G4 beginnend spaltenweise bis BF4, dann weiter in der nächsten Zeile ab G5 bis BF5 usw.), bis alle Zeilen durchlaufen sind. Es muss also über 1 Mio. Zellen durchlaufen.

Dieses Makro soll jedesmal, wenn es in einer Zelle einen Eintrag findet (heisst: Zelle ist nicht leer) den Inhalt der Zelle in eine andere Zieltabelle/Tabellenblatt schreiben. Dabei soll es den ersten Zellinhalt in die Zelle G2 des anderen Tabellenblattes schreiben, zusätzlich soll der Inhalt der zugehörigen ersten 6 Spalten der Quelltabelle in die Zellen A2-F2 der Zieltabelle geschrieben werden. Sobald das Makro auf die nächste "nicht leere Zelle" trifft soll es also in der Zieltabelle in die nächste Zeile wechseln und den Zellinhalt diesmal in G3 schreiben und wieder die Einträge in den ersten 6 Spalten der Quelltabelle in die Zellen A3-F3 der Zieltabelle kopieren.

Vielleicht kann mir jemand helfen, weil ich komm damit derzeit überhaupt nicht klar, vorallem das bedingte Kopieren der Inhalte der ersten 6 Spalten der Quelltabelle machen mir enorme Sorgen.

:)

mücke · 8. August 2013

Moin,

nicht schnell, aber ein Anfang *wink.gif* Tabellennamen ggf. anpassen.
Code:

Option Explicit

Sub Zellenuebertragen()

Dim j As Long, s As Long, z As Long

j = 2

With Worksheets("Tabelle1")
For z = 4 To .Cells(Rows.Count, "A").End(xlUp).Row
For s = 7 To 58
If Not IsEmpty(.Cells(z, s)) Then
.Range(.Cells(z, 1), .Cells(z, 6)).Copy _
Destination:=Worksheets("Tabelle2").Range("A" & j)
.Cells(z, s).Copy _
Destination:=Worksheets("Tabelle2").Range("G" & j)
j = j + 1
End If
Next
Next
End With

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

R J · 8. August 2013

Dieses Makro soll jedesmal, wenn es in einer Zelle einen Eintrag findet (heisst: Zelle ist nicht leer)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

...leg einen Filter drüber, das geht wesentlich schneller....
Allerdings sehe ich dennoch einen Haken. Vermutlich sind ja nicht alle Spalten einer Zeile leer, sondern nur ab und an fehlt ein Eintrag. Das bedeutet, dass Dir entweder nach dem Filtern (über alle Spalten mit leeren Inhalten) ein paar Zeilen fehlen oder Du, nach Ablauf eines Makros, wie Du es willst, trotzdem den gleichen Datenwust vorfindest wie im Original. Also, außer viel Aufwand sehe ich da keinen großen Nutzen. Nimm statt Excel lieber gleich eine richtige Datenbank. Da kannst Du dann entsprechende Abfragen generieren...

Ullitheheck · 8. August 2013

Herzlichen Dank, werd das jetzt mal austesten. *Smilie
Wünsche noch einen wunderschönen Tag.

Ullitheheck · 8. August 2013

Danke nochmal für deine Hilfe.
Das Makro tut auf jeden Fall, was es soll, nur dauert ein Durchlauf extrem lange (ca. 40 Minuten). Mein Kollege meint, dass es nicht sein kann, dass das durchlaufen von 1 Millionen Zeilen so lange dauert, da ich an einem sehr neuen Rechner arbeite (8 Prozessorkerne, 8 GB Ram, etc.).

Hat irgendjemand eventuell ne Ahnung, wie man das Makro beschleunigen kann? entweder durch Einstellungen in den Exceloptionen, oder durch die Anwendung von anderen "Bausteinen"? Hab schon die Autofehlerkorrektur in den Exceloptionen ausgeschaltet, hat aber auch nix gebracht.

Vielleicht hat ja noch jemand ne Idee dazu, wäre echt klasse.

PS: R J von was für einem Filter hast du gesprochen, den man über die Daten legen soll?

EarlFred · 8. August 2013

Hallo,

keine Ahnung, ob ich die Aufgabenstellung richtig entwirrt habe, aber probier mal folgenden Code:
Code:

Option Explicit

Sub test()
Dim i As Long
Dim rngValues As Range, rngFormulas As Range, rngCopy As Range

On Error Resume Next
For i = 4 To Worksheets("Quelle").Cells(Rows.Count, 1).End(xlUp).Row
With Worksheets("Quelle")
Set rngValues = .Range("G" & i & ":BF" & i).SpecialCells(xlCellTypeConstants)
Set rngFormulas = .Range("G" & i & ":BF" & i).SpecialCells(xlCellTypeFormulas)
End With
Select Case True
Case Not rngValues Is Nothing And Not rngFormulas Is Nothing
Set rngCopy = Union(rngValues, rngFormulas)
Case Not rngValues Is Nothing
Set rngCopy = rngValues
Case Not rngFormulas Is Nothing
Set rngCopy = rngFormulas
End Select

If Not rngCopy Is Nothing Then
With Worksheets("Ausgabe").Cells(Rows.Count, 1).End(xlUp)
Worksheets("Quelle").Range("A" & i & ":F" & i).Copy Destination:=.Offset(1, 0)
rngCopy.Copy
.Offset(1, 6).PasteSpecial (xlPasteValues)
End With
End If
Set rngValues = Nothing
Set rngFormulas = Nothing
Set rngCopy = Nothing
Next i
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ich habe angenommen, dass sowohl Werte als auch Formeln im Bereich der "Wochen" stehen. Wenn Du das einschränken könntest, könnte der Code schlanker werden.

Laufen viele Berechnugen / andere Codes (Ereignisprozeduren) in der Mappe? Dann könnte es beschleunigend wirken, diese vorher zu deaktivieren.
Nutze dafür z. B. Sepps "Tranquilizer":
http://www.ms-office-forum.net/forum...5&postcount=11

Grüße
EarlFred

Ullitheheck · 8. August 2013

Es handelt sich lediglich um Werte, also gar keine Formeln, die auf das andere Datenblatt übertragen werden müssen. Danke schonmal für den neuen Code.

EarlFred · 8. August 2013

Hallo,

dann kürzer:
Code:

Option Explicit

Sub test()
Dim i As Long
Dim rngCopy As Range

On Error Resume Next
For i = 4 To Worksheets("Quelle").Cells(Rows.Count, 1).End(xlUp).Row
Set rngCopy = Worksheets("Quelle").Range("G" & i & ":BF" & i).SpecialCells(xlCellTypeConstants)

If Not rngCopy Is Nothing Then
With Worksheets("Ausgabe").Cells(Rows.Count, 1).End(xlUp)
Worksheets("Quelle").Range("A" & i & ":F" & i).Copy Destination:=.Offset(1, 0)
rngCopy.Copy
.Offset(1, 6).PasteSpecial (xlPasteValues)
End With
End If

Set rngCopy = Nothing
Next i
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Grüße
EarlFred

Ullitheheck · 8. August 2013

Herzlichen Dank, scheint schon um einiges schneller zu gehen.

Wenn das Makro es jetzt noch schafft, nachdem ein Wert aus der Quelltabelle in die Zieltabelle kopiert wird, in der Zieltabelle eine Zeile nach unten "zu gehen" (Zeilenumbruch) dann wär das der letzte Schliff *Smilie .

Herzlichen Dank nochmal, echt super die Community hier.

EarlFred · 9. August 2013

Hallo,

achso, Ausgabe zeilenweise. Ist aber auch verworren beschrieben (eine Mustermappe macht vieles leichter - nicht nur für Dich die Beschreibung, sondern auch für uns Helfer das Verstehen und Testen).
Code:

Option Explicit

Sub test()
Dim i As Long
Dim rngCopy As Range

On Error Resume Next
For i = 4 To Worksheets("Quelle").Cells(Rows.Count, 1).End(xlUp).Row
Set rngCopy = Worksheets("Quelle").Range("G" & i & ":BF" & i).SpecialCells(xlCellTypeConstants)

If Not rngCopy Is Nothing Then
With Worksheets("Ausgabe").Cells(Rows.Count, 1).End(xlUp)
Worksheets("Quelle").Range("A" & i & ":F" & i).Copy Destination:=.Offset(1, 0).Resize(rngCopy.Cells.Count)
rngCopy.Copy
.Offset(1, 6).PasteSpecial Paste:=xlPasteValues, Transpose:=True
End With
End If

Set rngCopy = Nothing
Next i
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Grüße
EarlFred

Ullitheheck · 9. August 2013

Du bist der Beste. Daumen hoch.

mücke · 9. August 2013

Moin EarlFred,

... Du bist der Beste ...
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

da kann ich mich nur anschließen *Smilie
Habe heute wieder was dazu gelernt Danke!

Schönes Wochenende an alle *mrcool

Office: In Excel per VBA Range durchsuchen, Zellinhalt in anderes Tabellenblatt übertragen

In Excel per VBA Range durchsuchen, Zellinhalt in anderes Tabellenblatt übertragen

In Excel per VBA Range durchsuchen, Zellinhalt in anderes Tabellenblatt übertragen

In Excel per VBA Range durchsuchen, Zellinhalt in anderes Tabellenblatt übertragen

In Excel per VBA Range durchsuchen, Zellinhalt in anderes Tabellenblatt übertragen

In Excel per VBA Range durchsuchen, Zellinhalt in anderes Tabellenblatt übertragen - Similar Threads - Excel VBA Range

Kamera in Excel einbinden und per vba Fotos erstellen

VBA: Platzhalter ersetzen und evtl. leere Zeile einfügen

Excel Range als Bild in Word einfügen

excel vba range variable

VBA Excel-Sheet-Range in pdf-Datei speichern und als Anhang mit outlook versenden

Excel 2010 - Klick auf Zelle öffnet UserForm

Excel- VBA Range oder Cells?