HERBERS Excel-Forum - das Archiv
Bewerten Sie hier bitte das Excel-Portal
Auf geschlossene Arbeitsmappe zugreifen
edie

Hallo zusammen,
habe gestern das nachfolgende Makro bekommen, es funktioniert prima.
In Spalte A der aktuellen Tabelle ist eine Datumsreihe und in der Spalte A der DB eine sehr lange
(ca. 25. 000 Zeilen) Datumsreihe.
Bei Übereinstimung soll der Wert aus Spalte C der DB in die Spalte C der aktuellen Tabelle kopiert werden.
Würde gerne auf die Daten der DB, als geschlossene Areitsmappe, von mehreren Excel-Areitsmappen zugreifen, damit erspart man sich die verschieden DB Versionen und pflegt nur eine DB zugleich bleiben
die einzelnen Excel-Areitsmappen relativ klein.
Die Arbeitsmappe mit der DB soll im gleichen Ordner wie auch die Restlichen Excel- Areitsmappen abgelegt werden.
Sub Start ()
Dim vntA As Variant, vntRes As Variant
Dim lngIndexA As Long
Dim shA As Worksheet, shB As Worksheet, rng As Range
Set shA = ActiveSheet ' aktuelle Tabelle
Set shB = Worksheets("DB") ' Datenbank
vntA = shA.Range(shA.Cells(4, 1), shA.Cells(shA.Cells(shA.Rows.Count, 1).End(xlUp).Row, 3))
Set rng = shB.Range(shB.Cells(4, 1), shB.Cells(shB.Cells(shB.Rows.Count, 1).End(xlUp).Row, 1))
For lngIndexA = 1 To UBound(vntA, 1)
vntRes = Application.Match(CDbl(vntA(lngIndexA, 1)), rng, 0)
If IsNumeric(vntRes) Then
vntA(lngIndexA, 3) = rng.Cells(vntRes, 1).Offset(0, 2)
End If
Next
shA.Range(shA.Cells(4, 1), shA.Cells(shA.Cells(shA.Rows.Count, 1).End(xlUp).Row, 3)) = vntA
End Sub

Kann mir jemand dabei helfen? Ist so was möglich? Wie kann ich das Makro wieter verwenden?
Vielen Dank im Voraus.
Grüße

Suche mal nach GetObject(...) _oT
NoNet

_oT = "ohne Text"
AW: Auf geschlossene Arbeitsmappe zugreifen
Josef

Hallo Edie,
ein anderer Ansatz, der erfordert aber bestimmte Voraussetzungen in der Datenbank.
1.: Die Tabelle beginnt in A1
2.: Die erste Zeile enthält Überschriften
3.: Eine Spalte ist immer einheitlich formatiert, also zB. Spalte1 als Datum, Spalte2 Zahl, etc.
Das Format muss auf die ganze Spalte angewandt werden.
Im Code den Dateinamen mit Pfad, den Tabellennamen und die Zellbetreiche anpassen!
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Public Function ExcelTable(ByRef Path As String, ByRef Table As String, ByRef SourceRange As String) As Object
  Dim SQL As String
  Dim Con As String
  
  SQL = "select * from [" & Table & "$" & SourceRange & "]"
  Con = "Provider=Microsoft.Jet.OLEDB.4.0;" _
    & "Extended Properties=Excel 8.0;" _
    & "Data Source=" & Path & ";"
  Set ExcelTable = CreateObject("ADODB.Recordset")
  ExcelTable.Open SQL, Con, 3, 1
End Function

Sub Start()
  Dim vntA As Variant, vntB As Variant, vntC As Variant, vntRes As Variant
  Dim strFile As String, strTab As String, strRange1 As String, strRange2 As String
  Dim lngIndexA As Long
  Dim shA As Worksheet
  
  strFile = "E:\Temp\test.xls" 'DB Datei
  strTab = "DB" 'Tabelle in DB
  strRange1 = "A1:A30000" 'Bereich in DB mit Datum
  strRange2 = "C1:C30000" 'Bereich in DB mit Werten
  
  Set shA = ActiveSheet ' aktuelle Tabelle
  
  With ExcelTable(strFile, strTab, strRange1)
    vntB = .GetRows
    .Close
  End With
  
  With ExcelTable(strFile, strTab, strRange2)
    vntC = .GetRows
    .Close
  End With
  
  vntB = Application.Transpose(vntB)
  vntC = Application.Transpose(vntC)
  
  vntA = shA.Range(shA.Cells(4, 1), shA.Cells(shA.Cells(shA.Rows.Count, 1).End(xlUp).Row, 3))
  
  For lngIndexA = 1 To UBound(vntA, 1)
    vntRes = Application.Match(CStr(vntA(lngIndexA, 1)), vntB, 0)
    If IsNumeric(vntRes) Then
      vntA(lngIndexA, 3) = vntC(vntRes, 1)
    End If
  Next
  
  shA.Range(shA.Cells(4, 1), shA.Cells(shA.Cells(shA.Rows.Count, 1).End(xlUp).Row, 3)) = vntA
  
End Sub

Gruß Sepp

AW: Auf geschlossene Arbeitsmappe zugreifen
edie

Hallo Sepp,
vielen Dank, leider stopt das Makro bei: vntB = Application.Transpose(vntB)
Was muss noch angepasst werde?
Danke im Voraus.
Grüße
AW: Auf geschlossene Arbeitsmappe zugreifen
Josef

Hallo Edie,
hast du meine Anleitung befolgt? strRange1/strRange2 durfen jeweils nur eine Spalte umfassen!
Gruß Sepp

AW: Auf geschlossene Arbeitsmappe zugreifen
edie

Hallo Sepp,
die Fehlermeldung: "Laufzeitfehler '13'
Typen unverträglich"
Muss ein Verweis gesetzt werden?
Danke und Grüße
AW: Auf geschlossene Arbeitsmappe zugreifen
Josef

Hallo Edie,
hier noch mal ein angepasster Code, die Fehlermeldung sagt mir nichts, in welcher Zeile
erscheint der Fehler. Zeig mal wie du den Code angepasst hast.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Public Function ExcelTable(ByRef Path As String, ByRef Table As String, ByRef SourceRange As String) As Object
  Dim SQL As String
  Dim Con As String
  
  SQL = "select * from [" & Table & "$" & SourceRange & "]"
  Con = "Provider=Microsoft.Jet.OLEDB.4.0;" _
    & "Extended Properties=Excel 8.0;" _
    & "Data Source=" & Path & ";"
  Set ExcelTable = CreateObject("ADODB.Recordset")
  ExcelTable.Open SQL, Con, 3, 1
End Function

Sub Start()
  Dim vntA As Variant, vntB As Variant, vntC As Variant, vntRes As Variant
  Dim strFile As String, strTab As String, strRange1 As String, strRange2 As String
  Dim lngIndexA As Long
  Dim shA As Worksheet
  
  strFile = "E:\Temp\test.xls" 'DB Datei
  strTab = "DB" 'Tabelle in DB
  strRange1 = "A1:C30000" 'Bereich in DB, Datum steht in A Werte in C
  
  
  Set shA = ActiveSheet ' aktuelle Tabelle
  
  With ExcelTable(strFile, strTab, strRange1)
    vntB = .GetRows(, , 0)
    .MoveFirst
    vntC = .GetRows(, , 2)
    .Close
  End With
  
  vntA = shA.Range(shA.Cells(4, 1), shA.Cells(shA.Cells(shA.Rows.Count, 1).End(xlUp).Row, 3))
  
  For lngIndexA = 1 To UBound(vntA, 1)
    vntRes = Application.Match(CStr(vntA(lngIndexA, 1)), vntB, 0)
    If IsNumeric(vntRes) Then
      vntA(lngIndexA, 3) = vntC(0, vntRes - 1)
    End If
  Next
  
  shA.Range(shA.Cells(4, 1), shA.Cells(shA.Cells(shA.Rows.Count, 1).End(xlUp).Row, 3)) = vntA
  
End Sub

Gruß Sepp

AW: Auf geschlossene Arbeitsmappe zugreifen
edie

Hallo Sepp,
hier die Beispiel-Dateien:
https://www.herber.de/bbs/user/66806.zip
Vielen Dank im Voraus.
Grüße
Es funktioniert bereits nur noch...
edie

Hallo Sepp,
ich habe's. wenn der Bereich in strRange1 und strRange2 den tatsächlich gefüllten
Zeilen entspricht, dann funktioniert es. Prima!
Habe im der Beispiel-Datei in der DB nur mit 4410 Zeilen hochgeladen. Wenn man
jetzt strRange1 = "A1:A4410" und strRange2 = "C1:C4410" fest legt, dann ist alles Okay.
Leider sind die Spalten nach unten in der DB variabel lang mit der Zeit .
Wie kann ich die strRange1 und strRange1 flexibel halten?
Danke, vielen Dank und Grüße
AW: Auf geschlossene Arbeitsmappe zugreifen
Josef

Hallo Edie,
also bei mir läuft es ohne Probleme.
https://www.herber.de/bbs/user/66808.zip
Gruß Sepp

Besten Dank!
edie

Hallo Sepp,
die unter: https://www.herber.de/bbs/user/66808.zip
funktioniert bei mir auch.
Bin froh, dass es funktionert mit Deiner Hilfe.
Besten Dank und ein schönen Abend noch.
Grüße
Begrenzung von TRANSPOSE auf 5461 Zeilen
TRANSPOSE

Hallo Edi, hallo Sepp,
ich habe euren Thread nun weder verfolgt noch die Lösungsvorschläge selbst ausprobiert, aber beim Überfliegen von Edis Antworten ("leider stopt das Makro bei: vntB = Application.Transpose(vntB)" und "Habe im der Beispiel-Datei in der DB nur mit 4410 Zeilen hochgeladen.") klingeln bei mir die Alarmglocken : Bekannterweise kann man mit Application.Transpose nur max. 5461 Zellen einer Matrix transponieren, eine Erklärung dazu findet sich auf Philipp von Wartburgs Webseite :
http://xlam.ch/xlimits/arrays.htm#Limitationen%20der%20Transpose-Methode
Gruß und frohes Fest, NoNet
AW: Begrenzung von TRANSPOSE auf 5461 Zeilen
TRANSPOSE

Hallo NoNet,
ich kenne diese Limitation, war aber hier nicht relevant und
ausserdem ist im jetzigen Code kein Transpose mehr enthalten.
Danke trotzdem für's mitlesen/denken und auch dir ein frohes Fest!
Gruß Sepp

in xl2003 u. 2007 sind es 65535 oT.
Tino

habe bei 0 angefangen also 65536 oT.
Tino