Microsoft Excel

Herbers Excel/VBA-Archiv

Datensuche und import aus 2ter Mappe

Betrifft: Datensuche und import aus 2ter Mappe von: Daniel
Geschrieben am: 05.11.2014 16:07:42

Hallo Zusammen,

sitze jetzt schon ewig hier dran aber kapier's nicht, ich hoffe Ihr könnt mir helfen.

Habe das unten stehende Makro gefunden und versucht es für meine Zwecke anzupassen.
Ich versuche es dazu zu bekommen die Variablen Beleg (spalte E) und KND (Spalte G) in in einer anderen Datei zu suchen (müssen in gleicher Zeile stehen) und dann in die Zelle mit der Formel zu schreiben.

Über index und Verweis möchte ich es nicht machen da sich der Datensatz in der "Zahlungsliste" sehr schnell auf 100.000 und mehr Zeilen aufblähen wird.

-> extrem langsam

Es muss auch keine funktion sein sondern könnte auch einfach die daten in der spalte Qan Zeile 9 beim ausführen eintragen.

Const Filename = "Zahlungsliste ab 21.10.14.xlsb" 'Filename der Mappe die die Adressen enthält


Public Function Suche_ZahlDatum(ByVal Beleg As String, ByVal KDN As String)

Dim Pfad As String
Dim Anzahl As Long
Dim AD As Range
Dim firstAddress As String

Pfad = ActiveWorkbook.Path

If Right(Pfad, 1) <> "\" Then Pfad = Pfad & "\"
Workbooks.Open Filename:=Pfad & Filename, ReadOnly:=True
With ActiveWorkbook.Worksheets("Sheet1")
    Anzahl = .Cells(Rows.Count, 2).End(xlUp).Row
    With .Range("B2:B" & CStr(Anzahl))
        Set AD = .Find(Beleg, LookIn:=xlValues)
        If Not AD Is Nothing Then
            firstAddress = AD.Address
            Do
                If AD.Offset(0, 1).Value = KDN Then
                   Suche_ZahlDatum = AD.Offset(0, -1).Value
                   Exit Do
                End If
                Set AD = .FindNext(AD)
            Loop While Not AD Is Nothing And AD.Address <> firstAddress
        If Beleg <> "" Then
     Value = Beleg
  Else
     Value = ""
  End If
        End If
    End With
    Workbooks(Filename).Close SaveChanges:=False
End With
End Function
 

Vielen Dank für eure Hilfe

  

Betrifft: Beispieldaten? Fehlermeldungen? von: Frank
Geschrieben am: 05.11.2014 19:26:01

Hallo Daniel,

was klappt denn nicht? Gibt's Fehlermeldungen?
Heissen Deine Blätter in der ersten Mappe 'Sheet1', 'Sheet2' etc, oder irgendwie anders? With ActiveWorkbook.Worksheets("Sheet1") würde nämlich nur ein Blatt names 'Sheet1' ansprechen. Heisst das aber 'Tabelle1' oder 'Daten' oder '...', dann klappt es nicht.
Weiterhin kann ich probieren was ich will, innerhalb einer 'Public Function' liefert mir Set AD = .Find(Beleg, LookIn:=xlValues) für AD immer nur NOTHING. In einer Sub dagegen funktioniert es tadellos.
Letzteres könnte man umgehen, indem man mit

for i=1 to Anzahl
   if Beleg=Sheets("DeinBlatt").cells(i,Vergleichsspalte).value then
      'mach Dein Ding
   else
      'mach halt was anderes
   end if
next

die Zellen der Spalte mit den Belegnummern einzeln durchgeht und vergleicht.

Grüsse,
Frank


  

Betrifft: AW: Beispieldaten? Fehlermeldungen? von: Daniel
Geschrieben am: 06.11.2014 09:55:55

Hallo Frank,

vielen Dank für deine Antwort.

Also das Blatt heißt tatsächlich Sheet1 (ist ein Export aus einem SAP ähnlichen System). wie gesagt Ich muss den code nicht unbedingt als function haben.

Der code wurde im Original durch einen anderen aufgerufen, der in dem Tabellenblatt hinterlegt war und beim aktiviert der Zelle ausgeführt wurde.

Hier einmal das gesamte Original:

Code im Tabellenblatt:

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Abt As String
If Target.Column = 18 Then
  Cancel = True
  Application.ScreenUpdating = False
  Abt = Suche_MgL(Target.Offset(0, -15).Value, Target.Offset(0, -14).Value, Target.Offset(0, - _
17).Value)
  If Abt <> "" Then
     Target.Value = Abt
  Else
     Target.Value = "nicht gefunden"
  End If
  Application.ScreenUpdating = True
End If
End Sub
Und Hier die original Funktion aus dem Modul:
Option Explicit
Const Filename = "Liste.xlsx" 'Filename der Mappe die die Adressen enthält

Function Suche_MgL(Name As String, VorName As String, Abt As String)
Dim Pfad As String
Dim Anzahl As Long
Dim AD As Range
Dim firstAddress As String

Pfad = ActiveWorkbook.Path
If Right(Pfad, 1) <> "\" Then Pfad = Pfad & "\"
Workbooks.Open Filename:=Pfad & Filename, ReadOnly:=True
With ActiveWorkbook.Worksheets("Tabelle1")
    Anzahl = .Cells(Rows.Count, 2).End(xlUp).Row
    With .Range("F2:F" & CStr(Anzahl))
        Set AD = .Find(Name, LookIn:=xlValues)
        If Not AD Is Nothing Then
            firstAddress = AD.Address
            Do
                If AD.Offset(0, 1).Value = VorName And AD.Offset(0, -1).Value = Abt Then
                   Suche_MgL = AD.Offset(0, -4).Value
                   Exit Do
                End If
                Set AD = .FindNext(AD)
            Loop While Not AD Is Nothing And AD.Address <> firstAddress
        End If
    End With
    Workbooks(Filename).Close SaveChanges:=False
End With
End Function

Ich wollte den code so anpassen, das er entweder über eine Formel in den jeweiligen Zellen funktioniert oder ich ihn für das gesamte Blatt einfach ausführen kann (angepasst auf meine Dateinamen etc.)

Gruß Daniel


  

Betrifft: Beispieldaten? von: Frank
Geschrieben am: 06.11.2014 10:19:53

Hallo Daniel,

wenn ich Dich richtig verstehe, möchtest Du, dass die Funktion für alle Zeilen ausgeführt wird und nicht nur für die, wo man in Spalte R doppelklickt? Das könnte man machen, indem man den Code für das Doppelklickereignis in das Worksheet-Activate-Ereignis kopiert und entsprechend anpasst:

Private Sub Worksheet_Activate()
Dim Abt As String
lZ=range("A1").End(xlDown).Row
for i=2 to lZ
  Application.ScreenUpdating = False
  Abt = Suche_MgL(cells(i, 3).Value, cells(i, 4).Value, cells(i, 1).Value)
  If Abt <> "" Then
     cells(i, 18).Value = Abt
  Else
     cells(i, 18).Value = "nicht gefunden"
  End If
  Application.ScreenUpdating = True
next
End Sub

BeimStartwert für die Schleife gehe ich davon aus, dass die Daten in Zeile 2 beginnen und Zeile 1 die Überschriften enthält.

Grüsse,
Frank


  

Betrifft: AW: Beispieldaten? von: Daniel
Geschrieben am: 07.11.2014 17:30:12

Hallo Frank,

das funktioniert super.

Vielen Dank!!


 

Beiträge aus den Excel-Beispielen zum Thema "Datensuche und import aus 2ter Mappe"