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