Makro, Einträge zählen, mit Bedingungen
Thomas
ich hatte mich am 30.07.09 an das Forum gewendet mit einem Problem (Makro Einträge zählen, mit Bedingungen) und bekam Hilfe von Tino. Aufgrund Urlaub und anderen Problemen hat sich das Ganze verzörgert.
Leider kann ich den Beitrag nur nach anschauen und keine weiteren Texte dazu schreiben.
Ich benötige aber noch weitere Hilfe.
Das Makro funktioniert. Mein Problem besteht jedoch darin:
Ich habe eine Datei in der Daten gesammelt werden.
In dieser Datei öffnet ein Makro andere Excel-Dateien und liest verschiedene Daten aus.
Das Makro habe ich, wie in der Vorlage von Tino, in das bestehende Modul eingebaut bzw. angehängt.
Nur leider funktioniert es nicht. Wie muss ich das Makro einbauen?
Nochmals zum bisherigen Ablauf:
Makro zum Einlesen der Daten wird gestartet
Makro öffnet eine Datei
Makro liest Daten aus (z. B. Inhalt aus Range("Tabelle2!A2" usw.) und schreibt die Werte in
die Ausgangsdatei in eine bestimmte Reihe (z. B. in Reihe 25)
Makro schließt die Datei wieder
Makro öffnet die nächste Datei und schreibt die Werte in die nächste Reihe (z. B. Reihe 26)
Makro schließt die Datei wieder
usw.
Und so soll er jetzt sein:
Makro zum Einlesen der Daten wird gestartet
Makro öffnet eine Datei
Makro liest Daten aus (z. B. Inhalt aus Range("Tabelle2!A2" usw.) und schreibt die Werte in
die Ausgangsdatei in eine bestimmte Reihe (z. B. in Reihe 25)
und hier soll das Makro von Tino zur Ausführung kommen, damit der ermittelte Wert ebenfalls in die Reihe 25 eingetragen werden kann.
Makro schließt die Datei wieder
Makro öffnet die nächste Datei .
usw.
Das Makro von Tino:
Option Explicit
Sub Wertung_Nein()
Dim Ergebnis As Long
Ergebnis = Count_A_E_Nein(Sheets(2), False)
End Sub
Function Count_A_E_Nein(strSH As String, Optional booMatchCase As Boolean = True) As Long
Dim oDic As Object
Dim myAr
Dim A As Long
Dim Bereich As Range
Application.Volatile
With Sheets(strSH)
Set Bereich = .Range("A4", .Cells(.Rows.Count, 1).End(xlUp).Offset(0, 4))
If Intersect(Bereich, .Rows("1:3")) Is Nothing Then
myAr = Bereich
Set oDic = CreateObject("Scripting.Dictionary")
If booMatchCase Then
For A = 1 To UBound(myAr)
If myAr(A, 5) = "NEIN" Then
oDic(myAr(A, 1) & myAr(A, 5)) = 0
End If
Next A
Else
For A = 1 To UBound(myAr)
If LCase(myAr(A, 5)) = "nein" Then
oDic(LCase(myAr(A, 1)) & LCase(myAr(A, 5))) = 0
End If
Next A
End If
Count_A_E_Nein = oDic.Count
End If
End With
Set Bereich = Nothing
End Function
Thomas