Verbesserung VBA Code
19.03.2015 15:09:11
Plagiat1312
Heute habe ich AdHoc einen Code geschrieben der mir wohl doch etwas Arbeit abgenommen hat, da der vorliegende Fall für den Upload ins BW vorgesehen war und > 100.000 Zeilen hatte. Und Wahrscheinlich ändern sich die ein oder anderen Dateien noch einmal.
Beim schreiben ist mir aber aufgefallen, dass ich das ganze wirklich sehr eigenartig ( wenn auch immerhin schnell) gelöst habe.
die Aufgabe war:
Kopiere die Spalten E und G von Zeile 5 bis Zeile X (idealerweise zu ermitteln) und dann anschließend dazu immer eine weitere Spalte ab der Spalte K und gebe diese 3 Spalten dann untereinander in einer neuem Tabellenblatt aus.
Der Code funktioniert nur frage Ich mich doch ernsthaft ob es nicht deutlich bessere Lösungen gibt, gegebenenfalls über ein Array.
Danke jetzt schon demjenigen der sich die Mühe macht da Hirnschmalz reinzustecken, Ich bin auf jedenfall interessiert daran mich hier selbst zu verbessern!
Schönen Gruß
Plagiat1312
mein Code war:
Option Explicit
Option Base 1
Sub Extraktion()
Dim LngAnzahlZeilen As Long, LngAnzahlSpalten As Long, LngAnzahlZeilen2 As Long, i As Long
Dim wbphasing As Worksheet
Dim wbCOPA As Worksheet
Set wbphasing = ThisWorkbook.Worksheets("PhasingDaten")
Set wbCOPA = ThisWorkbook.Worksheets("COPA")
With wbphasing
LngAnzahlZeilen = IIf(IsEmpty(.Cells(Rows.Count, 6)), .Cells(Rows.Count, 6).End(xlUp).Row, . _
Rows.Count)
LngAnzahlSpalten = IIf(IsEmpty(.Cells(6, Columns.Count)), .Cells(6, Columns.Count).End(xlToLeft) _
_
.Column, .Columns.Count)
End With
For i = 11 To LngAnzahlSpalten
With wbphasing
.Range("E5:G" & LngAnzahlZeilen).Copy
End With
With wbCOPA
LngAnzahlZeilen2 = IIf(IsEmpty(.Cells(Rows.Count, 1)), .Cells(Rows.Count, 1).End(xlUp).Row, _
_
.Rows.Count)
.Range("A" & LngAnzahlZeilen2 + 1).PasteSpecial (xlPasteValues)
End With
With wbphasing
.Range(.Cells(5, i), .Cells(LngAnzahlZeilen, i)).Copy
End With
With wbCOPA
.Range("D" & LngAnzahlZeilen2 + 1).PasteSpecial (xlPasteValues)
End With
With wbphasing
.Cells(5, i).Copy
End With
With wbCOPA
.Range(.Cells(LngAnzahlZeilen2 + 1, 5), .Cells(LngAnzahlZeilen2 + 912, 5)).PasteSpecial ( _
xlPasteValues)
LngAnzahlZeilen2 = IIf(IsEmpty(.Cells(Rows.Count, 1)), .Cells(Rows.Count, 1).End(xlUp).Row, . _
Rows.Count)
End With
Next i
End Sub