Filtermasken zu externer Datenbank

Hallo an Allle,
Bin verzweifelt eine Möglichkeit zu finden Daten aus einer anderen Tabelle (Datenbank) auszufiltern und mit verschiedenen Masken aufzulisten oder darzustellen.
Bisher habe ich es immer mittels Import in die Maskentabelle und mit verschiedenen Formeln wie Sverweis(), SUMMENPRODUKT() oder INDEX(; VERGLEICH(;;)) geschafft.
Das Problem, die Datenbank ist jetzt erst bei knapp 11100 Datensätzen (soll bis 65000) und meine Masken Tabelle macht schlapp.
Mit den Formeln dauert Excel jetzt eine Ewigkeit alles zu berechnen, habe auch schon versucht die automatische Berechnung nur bei der aktiven Maske zu aktivieren, vergebens!!!
Daher mein anregen, welche ist die beste Möglichkeit (per VBA oder andere ?) die externe Datenbank auszufiltern mit den unten beschriebenen Filter Kriterien und dann in die aktuelle Maskendatei aufzulisten.
Die Filter Kriterien sind alle per Dropdown Menus:
1 KST -- Spalte("H")
2 Monat/Jahr oder KW -- Spalte("Datum") (Begin - Ende)
3 Nr -- Spalte("Nr")
4 Kategorie -- Spalte("Kat1")
5 Schicht F / S / N -- Spalte("Z";"AA";"AB")
6 Blatt -- Spalte("BlT")
Dropdown Menus KST / Blatt werden mittels vba ausgelesen und gefüllt.
max. Anzahl pro tag - 250 Personen
max. Anzahl pro Blatt - 25 Personen
Anbei ein Beispieldatei der Datenbank, Personaldaten und Masken
https://www.herber.de/bbs/user/75448.zip
Bin für jede Hilfe Dankbar
Gruß

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Paulo,
Ich habe mir das mal angeschaut und habe eine Frage:
Was soll mit dem Kopierbefehl '.Cells(1, lngCol).Copy Destination:=.Cells(1, lngCol).Resize(lngMaxRow)' in Makro 'Fill' bewirkt werden?
Die Zelle ist leer, und Du kopierst die Zelle in sich selbst. Bei mir kommt da eine Fehlermeldung.
Des weiteren sind Deine definierten Bereiche zu gross. .columns.count liefert 256, .rows.count 65536
Es waere besser, da die letzte benutzte Reihe bsw. Spalte zu ermitteln.
Fuer das Import-Makro schlage ich folgende Aenderung vor:

Sub IMPORTAR1()
Dim wbAct As Workbook
Dim objWorkbook As Workbook
Dim CaminhoInic
CaminhoInic = Range("E8")
If Range("E8") = "" Then
MsgBox "Indicar o Local do Ficheiro Primeiro " & vbNewLine & "" & vbNewLine & "Erst bitte  _
Pfad angeben "
Exit Sub
End If
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Set wbAct = ActiveWorkbook
Set objWorkbook = GetObject(CaminhoInic)
'DATEN
'objWorkbook.Worksheets("DATEN").Range("D1:T10").Copy
wbAct.Sheets("DATEN").Range("W1:AM10").Values = _
wbAct.Sheets("DATEN").Range("W1:AM10").Values   'PasteSpecial Paste:=xlPasteValues,  _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'BAS
'objWorkbook.Worksheets("DATEN").Range("A143:K250").Copy
'wbAct.Sheets("DATEN").Range("W44:AG151").PasteSpecial Paste:=xlPasteValues, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
wbAct.Sheets("DATEN").Range("W44:AG151").Values = _
objWorkbook.Worksheets("DATEN").Range("A143:K250").Values
'Fehl & KL Codes
'objWorkbook.Worksheets("DATEN").Range("A252:L283").Copy
'wbAct.Sheets("DATEN").Range("W153:AH184").PasteSpecial Paste:=xlPasteValues, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
wbAct.Sheets("DATEN").Range("W153:AH184").Values = _
objWorkbook.Worksheets("DATEN").Range("A252:L283").Values
'Kat
'objWorkbook.Worksheets("DATEN").Range("BV15:CH44").Copy
'wbAct.Sheets("DATEN").Range("W13:AI42").PasteSpecial Paste:=xlPasteValues, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
wbAct.Sheets("DATEN").Range("W13:AI42").Values = _
objWorkbook.Worksheets("DATEN").Range("BV15:CH44").Values
objWorkbook.Close SaveChanges:=False
Sheets("Menu").Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
MsgBox "Dados foram Importadas !!! " & vbNewLine & "" & vbNewLine & "Daten wurden  _
Importiert !!! "
End Sub

Lass' mich wissen, ob das eine Verbessrung gebracht hat.
Gruss
Dirk aus Dubai

Sub Fill() Dim lngCol&, lngMaxRow&, iCalc% With Application iCalc = .Calculation .ScreenUpdating = False .EnableEvents = False .Calculation = xlCalculationManual On Error GoTo ErrHandler: With Sheets("Import") lngMaxRow = .Range("AZ1") With .Range("A1:F1") For lngCol = 1 To .Columns.Count .Cells(1, lngCol).Copy .Cells(1, lngCol).Resize(lngMaxRow) Next lngCol End With End With ErrHandler: .Calculation = iCalc .EnableEvents = True .ScreenUpdating = True End With If Err.Number 0 Then MsgBox Err.Description, vbCritical + vbMsgBoxSetForeground + vbMsgBoxHelpButton, _ "Error: " & Err.Number, Err.HelpFile, Err.HelpContext End If End Sub

Beliebteste Forumthreads (12 Monate)

Filtermasken zu externer Datenbank

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