Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro, Einträge zählen, mit Bedingungen

Makro, Einträge zählen, mit Bedingungen
Thomas
Hallo zusammen,
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
Gruß
Thomas

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
nicht getestet...
15.09.2009 14:55:54
Tino
Hallo,
in etwa so müsste es gehen,
für mehrere Dateien müsstest Du noch eine Schleife drumrum bauen.
Sub Wertung_Nein()
Dim Ergebnis As Long
Dim meWB As Workbook

    'Datei mit schreibschutz öffnen, eventuell mit Schleife noch andere Dateien öffnen 
    Set meWB = Workbooks.Open(Filename:="C:\Ordner\Datei1.xls", ReadOnly:=True)
    
    With ThisWorkbook.Sheets("Daten") 'wo Ergebnis hin soll 
     .Cells(.Rows.Count, 25).End(xlUp).Offset(1, 0) = _
      Count_A_E_Nein(meWB.Sheets("Tabelle2"), False)
    End With

    meWB.Close False

Set meWB = Nothing
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)) 'hier den Zellbereich anpassen 
    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
Gruß Tino
Anzeige
AW: nicht getestet...
16.09.2009 06:56:48
Thomas
Hallo Tino,
sorry, ich hab beim Einbauen einen Fehler eingebaut.
Ergebnis = Count_A_E_Nein(Sheets(2), False)
Ich hab jetzt den Tabellennamen eingetragen, wie in deiner Vorlage, und dann funktioniert es.
Tut mir echt leid, dass ich dich nochmals bemüht habe.
Gruß
Thomas

322 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige