Live-Forum - Die aktuellen Beiträge
Datum
Titel
30.11.2023 19:46:26
Formeln kombinieren
30.11.2023 17:31:09
Import einer Userform - zusätzliche Leerzeile wird eingefügt
30.11.2023 16:58:13
Gruppiertes Säulendiagramm nicht bei 0 beginnend
Du konntest keine passende Antwort finden?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Anzeige
HERBERS
Excel-Forum
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1124to1128
1124to1128
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Auf geschlossene Arbeitsmappe zugreifen

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
23.12.2009 18:32:56
NoNet
_oT = "ohne Text"
AW: Auf geschlossene Arbeitsmappe zugreifen
23.12.2009 19:13:30
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

Anzeige
AW: Auf geschlossene Arbeitsmappe zugreifen
23.12.2009 19:29:23
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
23.12.2009 19:33:58
Josef
Hallo Edie,
hast du meine Anleitung befolgt? strRange1/strRange2 durfen jeweils nur eine Spalte umfassen!
Gruß Sepp

AW: Auf geschlossene Arbeitsmappe zugreifen
23.12.2009 19:37:49
edie
Hallo Sepp,
die Fehlermeldung: "Laufzeitfehler '13'
Typen unverträglich"
Muss ein Verweis gesetzt werden?
Danke und Grüße
AW: Auf geschlossene Arbeitsmappe zugreifen
23.12.2009 19:55:05
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

Anzeige
Es funktioniert bereits nur noch...
23.12.2009 20:42:42
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
Anzeige
Besten Dank!
23.12.2009 21:15:06
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
24.12.2009 00:44:23
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
Anzeige
AW: Begrenzung von TRANSPOSE auf 5461 Zeilen
24.12.2009 00:58:55
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.
24.12.2009 10:41:08
Tino
habe bei 0 angefangen also 65536 oT.
24.12.2009 10:42:13
Tino

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige