Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.07.2024 18:36:17
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Daten auslesen und einlesen mit VBA

Daten auslesen und einlesen mit VBA
09.04.2013 20:31:17
Daniel
Guten Abend,
aus einem Anwenderprogramm exportiere ich nach Auswertungslauf eine csv-Datei und speichere sie als xlsx-Datei. Die Datei kann mehrere hundert Datensätze enthalten.
Hieraus will ich per VBA ausgewählte Daten auslesen und in eine Berichtsdatei einlesen.
Dazu verwende ich folgenden Code:
Sub WerteFinden()
Application.ScreenUpdating=False
Set wb2=Workbooks.Open("C:\Berichte\AP.xlsx")
Set ws1=wb1.Sheets("Tabelle1")
Set ws2=wb2.Sheets("ABLstEin")
For i= "" & a & "" To "" & b & ""
Such = ws1.Range("A" & i).Value
Dim rngBereich As Range
Dim rngFund As Range
Set rngBereich = ws2.Range("D:D")
Set rngFund = rngBereich.Find(what:=Such, LookIn:=xlValues, LookAt:=xlWhole)
On Error Resume Next
rngFund.Activate
ActiveCell.Offset(0, 11).Select
ws2.Range("AO" & i) = Selection.Value
rngFund.Activate
If ActiveCell.Offset(0, 15).Value="H" Then  '  "H" steht für eine Haben-Buchung
ActiveCell.Offset(0, 14).Select
ws2.Range("AP" & i)=Selection.Value * -1
Else
ActiveCell.Offset(0, 14).Select
ws2.Range("AP" & i)=Selection.Value
End If
ws1.Range("C" & i)=ws2.Range("AO" & i).Value
ws1.Range("D" & i)=ws2.Range("AP" & i).Value
Next i
MsgBox ("Auswertung ist fertig!")
wb2.Save
wb2.Close
Application.ScreenUpdating=True
End Sub
Der Code funktioniert. Allerdings sehe ich mich maximal als fortgeschrittener Anfänger in VBA und suche nach einer Code-Verbesserung, mindestens der Zeilen zwischen den Markierungen.
Kann jemand helfen?
Grüße
Daniel B.

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Daten auslesen und einlesen mit VBA
10.04.2013 09:18:22
fcs
Hallo Daniel,
hier mein allerdings ungetesteter Verbesserungsvorschlag.
Gruß
Franz
Sub WerteFinden()
Application.ScreenUpdating = False
Dim rngBereich As Range
Dim rngFund As Range
Set wb2 = Workbooks.Open("C:\Berichte\AP.xlsx")
Set ws1 = wb1.Sheets("Tabelle1")
Set ws2 = wb2.Sheets("ABLstEin")
For i = "" & a & "" To "" & b & ""  'wo kommwn die Werte für a und b her ? Start/Endwert _
der Schleife sollten ganze Zahlen sein - keine Textkonstruktion!
'    For i = a To b  'sollte es auch tun
Such = ws1.Range("A" & i).Value
Set rngBereich = ws2.Range("D:D")
Set rngFund = rngBereich.Find(what:=Such, LookIn:=xlValues, LookAt:=xlWhole)
On Error Resume Next
If rngFund Is Nothing Then
'do nothing
Else
ws2.Range("AO" & i) = rngFund.Offset(0, 11).Value
rngFund.Activate 'Diese Zeile ist evtl auch noch überflüssig
If rngFund.Offset(0, 15).Value = "H" Then '  "H" steht für eine Haben-Buchung
ws2.Range("AP" & i) = rngFund.Offset(0, 14).Value * -1
Else
ws2.Range("AP" & i) = rngFund.Offset(0, 14).Value
End If
ws1.Range("C" & i) = ws2.Range("AO" & i).Value
ws1.Range("D" & i) = ws2.Range("AP" & i).Value
End If
Next i
MsgBox ("Auswertung ist fertig!")
wb2.Save
wb2.Close
Application.ScreenUpdating = True
End Sub

Anzeige
AW: Daten auslesen und einlesen mit VBA
10.04.2013 19:28:09
Daniel
Hallo Franz,
danke für Deinen Vorschlag. Leider war in meinem Beitrag nicht der gesamte Code zu sehen, obwohl vollständig eingegeben.
Deshalb nachfolgend noch mal alles inkl. Deiner Vorschläge.
If rngFund Is Nothing Then
'do nothing
For i = "" & a usw musste ich lassen, wurde anders nicht akzeptiert.
habe ich weg gelassen, führt bei mir zum Stopp der Prozedur. Ansonsten läuft die Prozedur wie meine eigene, ohne bemerkenswerte Veränderungen. Dann soll es so gut sein.
Hier nun der Code:
Sub WerteFinden()
Application.ScreenUpdating=False
Dim a As Long
Dim b As Long
a=8
b=Cells(Rows.Count, 1).End(xlUp).Row-1
Dim Such As Variant
Dim i As Integer
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set wb1=ThisWorkbook
Dim rngBereich As Range
Dim rngFund As Range
Set wb2=Workbooks.Open("C:\Berichte\AP.xlsx")
Set ws1=wb1.Sheets("Tabelle1")
Set ws2=wb2.Sheets("ABLstEin")
For i= "" & a & "" To "" & b & ""
Such = ws1.Range("A" & i).Value
Set rngBereich = ws2.Range("D:D")
Set rngFund = rngBereich.Find(what:=Such, LookIn:=xlValues, LookAt:=xlWhole)
On Error Resume Next
ws2.Range("AO" & i)=rngFund.Offset(0, 11).Value
rngFund.Activate
If rngFund.Offset(0, 15).Value="H" Then  '  "H" steht für eine Haben-Buchung
ws2.Range("AP" & i)=rngFund.Offset(0, 14).Value * -1 * -1
Else
ws2.Range("AP" & i)=rngFund.Offset(0, 14).Value
End If
ws1.Range("C" & i)=ws2.Range("AO" & i).Value
ws1.Range("D" & i)=ws2.Range("AP" & i).Value
Next i
MsgBox ("Auswertung ist fertig!")
wb2.Save
wb2.Close
Application.ScreenUpdating=True
End Sub

Anzeige

8 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige