Office: (Office 365) Makro/VBA Daten aus andere Mappe importiren und Formel anwenden

Hallo,
als erstes: ich habe keine Ahnung von Makros bzw deren Programmierung. Habe mir bisher beholfen mir Fragmente aus anderen Makros zu kopieren und mich versucht in letzten 48 Stunden ein wenig einzulesen.
Sollte es den Profis unter Euch zu sehr schmerzen mein Machwerk zu lesen bitte ich dies zu entschuldigen ;)


Ziel ist es aus der Quell-Datei eine Auswahl an spalten zu übertragen und bei bestimmten Spalten den Wert -1 zu Subtrahieren

Für die Datenübernahme habe ich Folgendes Makro. Hier ein wenig eingekürzt mit nur 3 Spalten:

Code:

Sub Daten_uebertragen()
With ThisWorkbook
    With ActiveSheet.Range("A2:A15000")
    .Value = DoIt("aufb Daten", "A2:A15000", .Value)
    End With
    With ActiveSheet.Range("G2:G15000")
    .Value = DoIt("aufb Daten", "C2:C15000", .Value)
    End With
    With ActiveSheet.Range("H2:H15000")
    .Value = DoIt("aufb Daten", "G2:G15000", .Value)
    End With
End With
End Sub
Private Function DoIt(sSheet As Variant, sAddr As String, V As Variant) As Variant
Dim w As Long, i As Long
Dim strInp As String
Dim oWb As Workbook
On Error GoTo fail
DoIt = V
w = Workbooks.Count
If w > 2 Then
For i = 1 To w
If Workbooks(i).Name <> ThisWorkbook.Name Then
strInp = strInp & CStr(i) & " = " & Workbooks(i).Name & vbNaewLine
End If
Next i
strInp = InputBox(strInp, "Mehrfachauswahl mit Ziffer treffen")
Set oWb = Workbooks(CInt(strInp))
Else
Set oWb = Workbooks(1)
If oWb.Name = ThisWorkbook.Name Then Set oWb = Workbooks(2)
End If
DoIt = oWb.Sheets(sSheet).Range(sAddr).Value
fail:
End Function

Das Funktioniert soweit Super.
Hat nur den kleinen Schönheitsfehler das er im Falle das mehr als 2 Excel Mappen auf sind für jede spalte nach der Quelle fragt. Hier wäre es schöner wenn er nur einmal für den gesamten Import nachfragt.

Probleme hab ich mit der Subtraktion.
Hierfür hatte ich folgenden Code angedacht:

Code:

Sub Subtrahtion()
Dim c As Range   ' c fuer Zelle
For Each c In Range("K2:K15000")
c = c - 1
Next
End Sub

Das macht er bis er zu einer Zelle mit Text kommt. Dann bricht er mit Fehlermeldung ab.
Hab es schon mit ein paar "If" Parameter versucht ohne Erfolg.
Auch das Ignorieren der Fehler brachte keinen erfolg. Abgesehen davon das er dann für eine Spalte ca 15 Minuten brauchte.

Der Text in der Zelle ist: "#ZAHL!". in der Quell-Datei steht in diesen Zellen "INVALID".


Hat wer von Euch eine Idee, ein Tipp oder sonstige nützliche Hinweise für mich?
Danke

Gruß
Markus

 

warum schleife über alle Dateien?
For i = 1 To w
If Workbooks(i).Name <> ThisWorkbook.Name Then
strInp = strInp & CStr(i) & " = " & Workbooks(i).Name & vbNaewLine
End If
Next i
weise strlnp nur Deinen Namen zu.

 

Hallo,

erstmal Danke für deine schnelle Reaktion / Antwort.

Aber welchen Namen meinst du den?
Das Problem ist ja das die Excel Dateien immer andere Namen haben.

So als allgemeine info.
Ich bekomme Wöchentlich bis zu 350 excel Dateien/Arbeitsmappen über einen Zeitraum von ca 6-8 Monaten.
Deren Namen ist wie folgt aufgebaut: Datum.Name.Uhrzeit
Diese Dateien werden von einen Datenlogger automatisch generiert.
Leider weilt die eigentlich dafür vorgesehene Person, unser Excel Guru, nicht mehr unter uns.

Gruß
Markus

 

Hallo Markus,

ich habne es wohl falsch gesehen das Du den Namen kennst für die Datei.
Es soll also Excel entrscheiden welche Datei.
Dafür habe ich keine Lösung und bin darum rausa.
Viel Erfolg.

Gruß Hajo

 

Hallo,

kein Ding. Solange man nur die Ziel- und Quell-Datei auf hat nervt die Abfrage ja nicht. Denn Fehler mehrere Excel Dateien auf zu haben macht man nur einmal, am Tag

Aber evtl hat du einen Tipp für mich wie ich Ihn dazu bei der Subtraktion die Zellen mit Text, in dem fall #ZAHL!, zu ignorieren oder zu überspringen..

Danke.

Gruß
Markus

 

Hallo,

das glaube ich sicher nicht, denn dein Code enthält einen Syntaxfehler! (--> vbNaewLine)
Diesen Syntaxfehler hättest du entdeckt, wenn du, wie es sich normalerweise gehört, als 1. Codezeile "Option Explicit" noch vor der Zeile "Sub Daten_uebertragen()" eingefügt hättest.

Das habe ich gemacht, indem ich die Workbook-Auswahl in eine eigene Funktion gelegt habe, separat vom Spaltenkopieren.
Viel Erfolg dabei für den Fall, dass mehr als 2 Dateien vorliegen.

Du meinst hier wohl ein paar "IF"-Anweisungen - unter Parameter versteht man in der Mathematik und auch beim Programmieren etwas ganz anderes.
Ich habe dir dazu eine kleine Sub gebaut. Diese Sub "Subtraktion" benötigt als Parameter einen Zellbereich. Dieser Zellbereich wird durchlaufen und jeweils geprüft, ob der jeweilige Zellinhalt numerisch ist - erst dann wird subtrahiert. Ich habe sie dir für alle 3 Spaltenbereiche eingefügt.

Code:

Option Explicit

Sub Daten_uebertragen()
   Dim QuellMappe As Workbook
   Dim QuellBlatt As Worksheet
   Dim ZielBereich As Range
 
   Set QuellMappe = QuellMappenAuswahl()
   Set QuellBlatt = QuellMappe.Worksheets("aufb Daten")
 
   Set ZielBereich = ActiveSheet.Range("A2:A15000")
   ZielBereich.Value = ImportSpalte(QuellBlatt, "A2:A15000")
   Subtraktion ZielBereich
 
   Set ZielBereich = ActiveSheet.Range("G2:G15000")
   ZielBereich.Value = ImportSpalte(QuellBlatt, "C2:C15000")
   Subtraktion ZielBereich
 
   Set ZielBereich = ActiveSheet.Range("H2:H15000")
   ZielBereich.Value = ImportSpalte(QuellBlatt, "G2:G15000")
   Subtraktion ZielBereich
   
End Sub

Private Function QuellMappenAuswahl() As Workbook
   Dim wbCt As Long, i As Long
   Dim Wb As Workbook
   Dim strInp As String
 
   wbCt = Workbooks.Count
   If wbCt > 2 Then
      For i = 1 To wbCt
         If Workbooks(i).Name <> ThisWorkbook.Name Then
            strInp = strInp & CStr(i) & " = " & Workbooks(i).Name & vbNewLine
         End If
      Next i
      strInp = InputBox(strInp, "Mehrfachauswahl mit Ziffer treffen")
      Set Wb = Workbooks(CInt(strInp))
   Else
      Set Wb = Workbooks(1)
      If Wb.Name = ThisWorkbook.Name Then Set Wb = Workbooks(2)
   End If
   Set QuellMappenAuswahl = Wb
End Function

Private Function ImportSpalte(wksQuelle As Worksheet, sAddr As String) As Variant
 
   ImportSpalte = wksQuelle.Range(sAddr).Value

End Function

Private Sub Subtraktion(Bereich As Range)
   Dim Zelle As Range
   For Each Zelle In Bereich.Cells
      If IsNumeric(Zelle.Value) Then
         Zelle.Value = Zelle.Value - 1
      End If
   Next Zelle
End Sub

 

Also wenn ich Dich richtig verstanden habe sollte das Ursprungs Makro keine Daten Importieren bzw übertragen da ein Syntaxfehler vorliegt. Richtig?
Hätte bzw sollte da nicht eine Fehlermeldung kommen?
Ich möchte garnicht in Abrede stellen das ich da einen Fehler drin habe. Nicht nach nur ein wenig einlesen in Foren usw. Aber ich versuche zu verstehen warum es dennoch Funktionierte.
Meine Aussage das es "Super Funktioniert" habe ich nach ca 8-10 Versuchen getroffen.
Da habe ich in jeder spalte, 27, die ersten und letzen 20 Zellen geprüft so wie Stichproben.
Eine Fehlermeldung kam auch nicht.

Touché

Dein Makro Funktioniert.
Danke erstmal dafür.
Was mich irritiert ist das es ewig braucht.
Ich hab es erstmal 1zu1 verwendet also nur mit den 3 Spalten.
Das Importieren ging, wie auch schon davor mit allen 27 Spalten, in Sekunden.
Aber als dann die Berechnung los ging sprang die CPU last auf ca 70%. Davor lag sie bei 5-10%. Nach ca 20 Minuten war er dann Fertig.
Also wesentlich komplizierte Formeln direkt in excel bei ca gleichen Anzahl an zu berechneten Zellen geht in Sekunden. Aber bei einer Subtraktion von -1 braucht er 20 Minuten?
Sind Makros einfach so langsam?
Gibt es andere Gründe?



Danke für Eure Hilfe.

 

Hallo,

Nicht unbedingt. Da du den Variablen-Deklarationszwang nicht eingeschaltet hattest, hat der VBA-Compiler als er die nicht deklarierte Variable "vbNaewLine" entdeckte, dieser zuallererst den Datentyp "Variant" verpasst und dann vermutlich den Variant-Wert "Empty". Dieser Variablenwert wird dann je nach Programmumgebung entweder als numerische 0 oder als Zeichenkettenwert "" oder was immer was gerade benötigt wird und möglich ist, ausgewertet.

Genau diese geschilderte Situation stellt aus Sicht eines Programmierers eine (enorme) Heimtücke dar. Das Programm kann sich einige Zeit ganz "vernünftig" verhalten und dann kann plötzlich unter Umständen ein unerklärbares Verhalten eintreten. Solche Fehler sind meist (sehr) schwer zu finden, weil man als menschlicher Programmleser einfach darüber hinweg zu lesen geneigt ist.

Man kann das Problem mit den Flüchtigkeitsfehlern sehr leicht beheben, eben indem man die Compiler-Option "Option Explicit" an den Anfang eines jeden Programmmoduls stellt. Das hat zur Folge, dass man jede verwendete Variable zuerst deklarieren muss. Flüchtigkeitsfehler werden andererseits damit sofort entdeckt, sobald man den Befehl zum Kompilieren gibt.

Leider hat Microsoft diese voreinstellbare Option standardmäßig ausgeschaltet, damit so spontane "Kraut-und-Rüben"-Programme ermöglicht werden.

Bei je 15000 Zellen pro Spalte, wobei in jeder Zelle überprüft werden muss, ob nicht-numerischer Müll enthalten ist - das braucht eben seine Zeit. Die Subtraktion, auch wenn es eine Variant-Zahl ist, wird in Summe nur einen Bruchteil an Zeit davon brauchen.
Eine weitere Möglichkeit wäre, in der SUB die Fehlerbehandlung abzuschalten und am Ende wieder einzuschalten:

Code:

Private Sub Subtraktion(Bereich As Range)
   Dim Zelle As Range
   On Error Resume Next
   For Each Zelle In Bereich.Cells
        Zelle.Value = Zelle.Value - 1
   Next Zelle
   On Error GoTo 0
End Sub

 

Ah. ok.

Hab ich gleich mal Aktiviert.

Werd morgen mal testen was bzw ob die Fehlerbehandlung ausstellen an zeit einbringt.

Danke.

Gruß
Markus

 

Kann man sich eigentlich irgendwo anzeigen lassen wie lange ein Makro gebraucht hat?
Oder sowas wie ein Protokoll?

 

Hallo,

für Testzwecke kann man eine Ausgabe tätigen zB. ins Direktbereichfenster des VBA-Editors durch folgende Anweisung:
debug.print Now()
Man erhält dann in diesem Fenster eine Datenausgabe wie zB.
02.11.2022 10:36:14
Man kann den Wert der Now()-Funktion genauso gut in eine Zelle ausgeben, zB. in die aktive Zelle:
Activecell.Value = Now()
oder in die Statuszeile von Excel:
Application.Statusbar = Now()

Das sind die einfachsten Möglichkeiten. Weitere Möglichkeiten benötigen leider etwas Detailwissen. Das Einfachste davon ist zB. die Variable Timer. Sie zählt die Sekunden seit Mitternacht - auch Bruchteile von Sekunden.
Vor Aufruf des Makros, dessen Zeidauer man ermitteln möchte, führt man folgende Wertzuweisung aus:
Dim StartZeit As Single, EndeZeit As Single
StartZeit = Timer
Dann führt man das betreffende Makro aus, das eine gewisse Dauer hat.
Hinterdrein führt man die folgende Wertzuweisung aus:
EndeZeit = Timer
Mit dem Ausdruck EndeZeit-StartZeit erhält man die Dauer in Sekunden (und Sekundenbruchteilen).