Anpassung Makro

Hallo zusammen,
folgende zwei "Problemchen" sollten für Euch keine große Herausforderung sein, ich allerdings steh gerade mächtig auf dem Schlauch. Deshalb freue ich mich sehr über Hilfe.
Im Folgenden findet Ihr zwei Dateien. Eine Exceldatei, die beispielhaft für mehrere steht, welche ausgelesen werden soll und eine auslesende Monitoringdatei.
https://www.herber.de/bbs/user/95843.xlsm
https://www.herber.de/bbs/user/95844.xlsm
Das Makro, welches tadellos funktioniert muss lediglich an zwei Stellen angepasst werden:
1. zur Zuordnung der Daten zu den Projekten ,soll die Zelle B1 (Projektnr.) aus den Reitern 200005G1, 200005G2 und 200005G3 auch unbedingt mit ausgelesen und oberhalb eingetragen werden (in die Monitoringdatei) - hierzu muss der Bereich einfach nur vergrößert werden. ich bekomm´s irgendwie nicht hin
2. ich möchte, dass aus den oben genannten Reitern die sechsstellige Projektnr. verschwindet (also dort nur noch G1,G2 und G3 steht) UND das Makro weiterhin so funktioniert. Auch hier habe ich mich probiert und bin gescheitert.
Tausend Dank schon im Voraus bei Eurer Unterstützung für dieses kleine Anpassungsproblem.
Beste Grüße
Eric

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Eric,
zu 1. Projekt-Nummer zusätzlich auslesen
Die Projekt-Nummer ist hier der Feldname und muß anders ausgewertet werden.
Dazu musst du die folgende Function im Modul2 wie folgt anpassen.

'Function im Modul2
Function oExAbfrage(ByVal sFullPath$, strBereich$, arrayData(), nCol&)
Dim strSQL$, n&, nBereiche&
If cnMDB Is Nothing Then ADO_Connect (sFullPath)
strSQL = "SELECT * FROM [" & strBereich$ & "]"
If adoRS Is Nothing Then
Oben_Recordset strSQL, adOpenForwardOnly, adLockReadOnly
End If
With adoRS
If Not .BOF Then
.MoveFirst
arrayData(1, nCol) = .Fields(1).Name   'neue Zeile
Do While Not .EOF
'###             arrayData(.Fields(0), nCol) = .Fields(1)
arrayData(.Fields(0) + 1, nCol) = .Fields(1)
.MoveNext
Loop
End If
End With
Close_Datenbank
End Function

In den Auslese-Makros muss du die Array-Größe und die Bereichs-Zeilen anpassen. Hier am Beispiel von Gate1:

Sub LeseDatenG1()
Dim sFile$, sPath$, arrayData(), n
sPath = ThisWorkbook.Path & "\"
'Anzahl Dateien feststellen
sFile = Dir(sPath & "pra_*")
Do While Len(sFile)
n = n + 1
sFile = Dir
Loop
'###  ReDim arrayData(1 To 39, 1 To n)
ReDim arrayData(1 To 40, 1 To n)
'###  Tabelle1.Range("B2:B40").Resize(, Columns.Count - 1).ClearContents
Tabelle1.Range("B2:B41").Resize(, Columns.Count - 1).ClearContents
'Dateien lesen
n = 0
sFile = Dir(sPath & "pra_*")
Do While Len(sFile)
n = n + 1
'###    oExAbfrage sPath & sFile, Mid(sFile, 5, 6) & "G1$A:B", arrayData, (n)
oExAbfrage sPath & sFile, "G1$A:B", arrayData, (n)
sFile = Dir
Loop
'###  Tabelle1.Range("B2:B40").Resize(, n) = arrayData
Tabelle1.Range("B2:B41").Resize(, n) = arrayData
End Sub

Wenn in den Namen der Tabellenblätter in den Quelldateien die Projekt-Nr. wegfällt, dann ändert sich in den Auslesemakros, wie oben gezeigt folgende Zeile:

    oExAbfrage sPath & sFile, Mid(sFile, 5, 6) & "G1$A:B", arrayData, (n)

Gruß
Franz
P.S: Deine zwei "Problemchen" sind schon eine Herausforderung, denn ersten muss man an einer Vielzahl von Zeilen kleine Änderungen machen und zweiten muss man sich mit der Record-Schruktur bei ADO-Connections auskennen, was bei mir jetzt auch mehr intuitiv als durch genaues Wissen funktioniert hat.

Beliebteste Forumthreads (12 Monate)

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread