Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1140to1144
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Sumif mit zwei Bedingungen

Sumif mit zwei Bedingungen
jeron
Hallo liebe Excelfreunde,
ich habe einen Code für einen Export von Zahlen in eine andere Tabelle geschrieben und
brauche bitte Hilfe bei der Formulierung einer Variable.
Die Variable lngCnt gibt an wie oft eine Schleife ablaufen soll.
Momentan ist ihr noch ein zellwert zugeordnet.
Jetzt möchte ich aber dass die Variable eine zahl ist, die sich erst erechnet werden muss.
Hier mein Code mit den gewünschten Bedingungen für die Erechnung der Zahl, als Kommentar eingefügt.
Sub importData()
Dim objFiles() As Object
Dim objWB As Workbook, objSh As Worksheet
Dim lngRow As Long, lngCnt As Long, lngIndex As Long, lngRet As Long
Dim strTab As String, strPath As String
Dim vntRet As Variant
Dim lngN As Variant
Dim antwort As Long
If ActiveSheet.ProtectContents = True Then
MsgBox "Blattschutz bitte unter Extras -> Schutz aufheben"
End
End If
antwort = MsgBox("Soll der Import gestartet werden?", vbYesNo)
If antwort = vbYes Then
End If
If antwort = vbNo Then
End
End If
If ActiveSheet.Range("$I$1").Value  0 Then
Set objSh = ThisWorkbook.Sheets("Tabelle1") 'Name der Zieltabelle - Anpassen!
    lngCnt = objSh.Range("I1")
'Hier soll statt lngCnt=objSh.Range ("I1") die Anzahl der Zellen, die in Worksheet objWB
'von A24:A500,  >= Zahl "C1" (objSh)  sind und
'=" & objSh.Range("C1") And "
lngRow = Application.Max(18, objSh.Cells(objSh.Rows.Count, 18).End(xlUp).Row + 1)
For lngIndex = 0 To lngRet - 1
If Not objFiles(lngIndex) = ThisWorkbook.FullName Then
Set objWB = Workbooks.Open(objFiles(lngIndex))
If SheetExist(strTab, objWB) Then
With objWB.Sheets(strTab)
vntRet = Application.Match(objSh.Range("C1"), .Range("A24:A500"), 0)
If IsNumeric(vntRet) Then
For lngN = 0 To lngCnt - 1
If .Cells(vntRet + lngN, 2)  "" And .Cells(vntRet + lngN, 3)  "" Then
.Cells(vntRet + lngN, 1).Copy objSh.Cells(lngRow, 3)
.Cells(vntRet + lngN, 2).Copy objSh.Cells(lngRow, 5)
.Cells(vntRet + lngN, 3).Copy objSh.Cells(lngRow, 6)
.Cells(vntRet + lngN, 4).Copy objSh.Cells(lngRow, 7)
.Cells(vntRet + lngN, 7).Copy objSh.Cells(lngRow, 8)
objSh.Cells(lngRow, 4) = .Range("B3").Value
objSh.Cells(lngRow, 1) = "OC"
objSh.Cells(lngRow, 12) = "ja"
lngRow = lngRow + 1
End If
Next
End If
End With
End If
objWB.Close False
End If
Next
End If
MsgBox "Der Import ist erfolgt"
ErrExit:
With Err
If .Number  0 Then MsgBox "Fehler " & .Number & vbLf & vbLf & _
.Description & vbLf & vbLf & "In Prozedur (importData) in Modul Modul1", _
vbExclamation, "Fehler in Makro bitte im VBA Code nachsehen"
End With
GMS True
Set objWB = Nothing
Set objSh = Nothing
End Sub

Leider fehlt mir das Verständnis dafür.
Über jeden Hinweis bzw. hilfe würde ich mich sehr freuen.
Viele Grüße aus München,
Jeron

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Sumif mit zwei Bedingungen
24.02.2010 16:32:55
Josef
Hallo Jeron,

schönen Code hast du da geschrieben;-))
Vollkommen ungetestet!

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub importData()
  Dim objFiles() As Object
  Dim objWB As Workbook, objSh As Worksheet
  Dim lngRow As Long, lngCnt As Long, lngIndex As Long, lngRet As Long
  Dim strTab As String, strPath As String
  Dim vntRet As Variant
  Dim lngN As Variant
  Dim antwort As Long
  
  If ActiveSheet.ProtectContents = True Then
    MsgBox "Blattschutz bitte unter Extras -> Schutz aufheben"
    Exit Sub
  End If
  
  antwort = MsgBox("Soll der Import gestartet werden?", vbYesNo)
  If antwort <> vbYes Then
    Exit Sub
  End If
  
  If ActiveSheet.Range("$I$1").Value <= 0 Then
    MsgBox "Der Wert in Zelle C1 darf nicht größer als in E1 sein "
    Exit Sub
  End If
  
  On Error GoTo ErrExit
  GMS
  
  strPath = Range("K1")
  
  strTab = Range("M1") ' "Mediaplanung2010" 'Tabellenname aus welcher ausgelesen wird - Anpassen!
  
  lngRet = FileSearchINFO(objFiles, strPath, "*.xls*", True)
  
  If lngRet > 0 Then
    
    Set objSh = ThisWorkbook.Sheets("Tabelle1") 'Name der Zieltabelle - Anpassen!
    
    lngRow = Application.Max(18, objSh.Cells(objSh.Rows.Count, 18).End(xlUp).Row _
      + 1)
    
    For lngIndex = 0 To lngRet - 1
      If Not objFiles(lngIndex) = ThisWorkbook.FullName Then
        Set objWB = Workbooks.Open(objFiles(lngIndex))
        If SheetExist(strTab, objWB) Then
          vntRet = Evaluate("SUMPRODUCT(([" & objWB.Name & "]'" & strTab & "'!" & _
            Range("A24:A500").Address & ">=" & objSh.Range("C1") & ")*([" & _
            objWB.Name & "]'" & strTab & "'!" & Range("A24:A500").Address & "<=" & _
            objSh.Range("E1") & "))")
          If IsNumeric(vntRet) Then
            lngCnt = vntRet
            With objWB.Sheets(strTab)
              vntRet = Application.Match(objSh.Range("C1"), .Range("A24:A500"), 0)
              If IsNumeric(vntRet) Then
                For lngN = 0 To lngCnt - 1
                  If .Cells(vntRet + lngN, 2) <> "" And .Cells(vntRet + lngN, 3) _
                    <> "" Then
                    
                    .Cells(vntRet + lngN, 1).Copy objSh.Cells(lngRow, 3)
                    .Cells(vntRet + lngN, 2).Copy objSh.Cells(lngRow, 5)
                    .Cells(vntRet + lngN, 3).Copy objSh.Cells(lngRow, 6)
                    .Cells(vntRet + lngN, 4).Copy objSh.Cells(lngRow, 7)
                    .Cells(vntRet + lngN, 7).Copy objSh.Cells(lngRow, 8)
                    objSh.Cells(lngRow, 4) = .Range("B3").Value
                    objSh.Cells(lngRow, 1) = "OC"
                    objSh.Cells(lngRow, 12) = "ja"
                    lngRow = lngRow + 1
                  End If
                Next
              End If
            End With
          End If
        End If
        objWB.Close False
      End If
    Next
  End If
  
  MsgBox "Der Import ist erfolgt"
  
  ErrExit:
  With Err
    If .Number <> 0 Then MsgBox "Fehler " & .Number & vbLf & vbLf & .Description _
      & vbLf & vbLf & "In Prozedur (importData) in Modul Modul1", vbExclamation, _
      "Fehler in Makro bitte im VBA Code nachsehen"
  End With
  
  GMS True
  
  Set objWB = Nothing
  Set objSh = Nothing
  
End Sub

Gruß Sepp

Anzeige
AW: Sumif mit zwei Bedingungen
24.02.2010 16:58:16
jeron
Hallo Sepp,
natürlich habe ich den Code nicht geschrieben sondern DU. Wofür ich dir auch total dankbar bin.
Ich kann deinen Code gerade mal so verstehen :-)
Nur funktioniert der Code jetzt noch nicht. Darf ich fragen wieso du das Summenprodukt gewählt hast.
Es ist ja eigentlich eine Addition und kein Produkt oder?
Es funktioniert auch leider nicht. Es kommt aber keine Fehlermeldung, sondern es wird halt nichts importiert.
Kannst du netterweise bitte noch mal einen Blick darauf werfen?
Ich habe noch eine Bedingung angepasst aber daran kann es eigentlich nicht liegen.
If IsNumeric(vntRet) Then
For lngN = 0 To lngCnt - 1
If .Cells(vntRet + lngN, 2) "_" And .Cells(vntRet + lngN, 2) "" Then
.Cells(vntRet + lngN, 1).Copy objSh.Cells(lngRow, 3)
.Cells(vntRet + lngN, 2).Copy objSh.Cells(lngRow, 5)
.Cells(vntRet + lngN, 3).Copy objSh.Cells(lngRow, 6)
.Cells(vntRet + lngN, 4).Copy objSh.Cells(lngRow, 7)
.Cells(vntRet + lngN, 7).Copy objSh.Cells(lngRow, 8)
objSh.Cells(lngRow, 4) = .Range("B3").Value
objSh.Cells(lngRow, 1) = "OC"
objSh.Cells(lngRow, 12) = "ja"
lngRow = lngRow + 1
End If
Danke und beste Grüße,
jeron
Anzeige
AW: Sumif mit zwei Bedingungen
24.02.2010 17:12:24
Josef
Hallo Jeron,

SUMMENPRODUKT() weil wir ja zwei Kriterien haben.
Jetzt sollte es laufen.

Sub importData()
  Dim objFiles() As Object
  Dim objWB As Workbook, objSh As Worksheet
  Dim lngRow As Long, lngCnt As Long, lngIndex As Long, lngRet As Long
  Dim strTab As String, strPath As String
  Dim vntRet As Variant
  Dim lngN As Variant
  Dim antwort As Long
  
  If ActiveSheet.ProtectContents = True Then
    MsgBox "Blattschutz bitte unter Extras -> Schutz aufheben"
    Exit Sub
  End If
  
  antwort = MsgBox("Soll der Import gestartet werden?", vbYesNo)
  If antwort <> vbYes Then
    Exit Sub
  End If
  
  If ActiveSheet.Range("$I$1").Value <= 0 Then
    MsgBox "Der Wert in Zelle C1 darf nicht größer als in E1 sein "
    Exit Sub
  End If
  
  On Error GoTo ErrExit
  GMS
  
  strPath = Range("K1")
  
  strTab = Range("M1") ' "Mediaplanung2010" 'Tabellenname aus welcher ausgelesen wird - Anpassen!
  
  lngRet = FileSearchINFO(objFiles, strPath, "*.xls*", True)
  
  If lngRet > 0 Then
    
    Set objSh = ThisWorkbook.Sheets("Tabelle1") 'Name der Zieltabelle - Anpassen!
    
    lngRow = Application.Max(18, objSh.Cells(objSh.Rows.Count, 18).End(xlUp).Row _
      + 1)
    
    For lngIndex = 0 To lngRet - 1
      If Not objFiles(lngIndex) = ThisWorkbook.FullName Then
        Set objWB = Workbooks.Open(objFiles(lngIndex))
        If SheetExist(strTab, objWB) Then
          vntRet = Evaluate("SUMPRODUCT(('[" & objWB.Name & "]" & strTab & "'!" & _
            Range("A24:A500").Address & ">=" & objSh.Range("C1") & ")*('[" & _
            objWB.Name & "]" & strTab & "'!" & Range("A24:A500").Address & "<=" & _
            objSh.Range("E1") & "))")
          If IsNumeric(vntRet) Then
            lngCnt = vntRet
            With objWB.Sheets(strTab)
              vntRet = Application.Match(objSh.Range("C1"), .Range("A24:A500"), 0)
              If IsNumeric(vntRet) Then
                For lngN = 0 To lngCnt - 1
                  If .Cells(vntRet + lngN, 2) <> "" And .Cells(vntRet + lngN, 3) _
                    <> "" Then
                    
                    .Cells(vntRet + lngN, 1).Copy objSh.Cells(lngRow, 3)
                    .Cells(vntRet + lngN, 2).Copy objSh.Cells(lngRow, 5)
                    .Cells(vntRet + lngN, 3).Copy objSh.Cells(lngRow, 6)
                    .Cells(vntRet + lngN, 4).Copy objSh.Cells(lngRow, 7)
                    .Cells(vntRet + lngN, 7).Copy objSh.Cells(lngRow, 8)
                    objSh.Cells(lngRow, 4) = .Range("B3").Value
                    objSh.Cells(lngRow, 1) = "OC"
                    objSh.Cells(lngRow, 12) = "ja"
                    lngRow = lngRow + 1
                  End If
                Next
              End If
            End With
          End If
        End If
        objWB.Close False
      End If
    Next
  End If
  
  MsgBox "Der Import ist erfolgt"
  
  ErrExit:
  With Err
    If .Number <> 0 Then MsgBox "Fehler " & .Number & vbLf & vbLf & .Description _
      & vbLf & vbLf & "In Prozedur (importData) in Modul Modul1", vbExclamation, _
      "Fehler in Makro bitte im VBA Code nachsehen"
  End With
  
  GMS True
  
  Set objWB = Nothing
  Set objSh = Nothing
  
End Sub

Gruß Sepp

Anzeige
AW: Sumif mit zwei Bedingungen
25.02.2010 09:53:35
jeron
Hallo Sepp,
also erstmal vielen Dank.
Das Summenprodukt zählt zwar richtig, habe mir die Werte einfach mal ausspucken lassen.
Aber die Kopiervorgänge funktionieren nicht mehr einwandfrei.
Ich kann mir das leider gar nicht erklären.
Habe ich im Code markiert.
Sub importData()
Dim objFiles() As Object
Dim objWB As Workbook, objSh As Worksheet
Dim lngRow As Long, lngCnt As Long, lngIndex As Long, lngRet As Long
Dim strTab As String, strPath As String
Dim vntRet As Variant
Dim vntAnzahl As Long
Dim lngN As Variant
Dim antwort As Long
If ActiveSheet.ProtectContents = True Then
MsgBox "Blattschutz bitte unter Extras -> Schutz aufheben"
Exit Sub
End If
antwort = MsgBox("Soll der Import gestartet werden?", vbYesNo)
If antwort  vbYes Then
Exit Sub
End If
If ActiveSheet.Range("$I$1").Value  0 Then
Set objSh = ThisWorkbook.Sheets("Tabelle1") 'Name der Zieltabelle - Anpassen!
lngRow = Application.Max(18, objSh.Cells(objSh.Rows.Count, 18).End(xlUp).Row _
+ 1)
For lngIndex = 0 To lngRet - 1
If Not objFiles(lngIndex) = ThisWorkbook.FullName Then
Set objWB = Workbooks.Open(objFiles(lngIndex))
'öffnet die Workbooks nacheinander
If SheetExist(strTab, objWB) Then
vntAnzahl = Evaluate("SUMPRODUCT(('[" & objWB.Name & "]" & strTab & "'!" & _
Range("A24:A150").Address & ">=" & objSh.Range("C1") & ")*('[" & _
objWB.Name & "]" & strTab & "'!" & Range("A24:A150").Address & "    ' Summenprodukt zählt richtig, passt also, aber_
'Schleife mit lngCnt funktioniert momentan nicht richtig, bei SummenProdukt = 3, nur
' 2 Schritte

If IsNumeric(vntAnzahl) Then
lngCnt = vntAnzahl
With objWB.Sheets(strTab)
vntRet = Application.Match(objSh.Range("C1"), .Range("A24:A150"), 0)
If IsNumeric(vntRet) Then
For lngN = 0 To lngCnt - 1
If .Cells(vntRet + lngN, 2)  "_" And .Cells(vntRet + lngN, 2)  "" Then
       ' ab hier wird wild kopiert, nicht erst ab Zeile 24
'sondern momentan die Inhalte aus A2(objWB) und A3(objWB) in Spalte 3 (objSH) _
_
_
'und B2 und B3(objWB) in Spalte 4 (objSH)
' ich kann mir das nicht erklären
.Cells(vntRet + lngN, 1).Copy objSh.Cells(lngRow, 3)
.Cells(vntRet + lngN, 2).Copy objSh.Cells(lngRow, 5)
.Cells(vntRet + lngN, 3).Copy objSh.Cells(lngRow, 6)
.Cells(vntRet + lngN, 4).Copy objSh.Cells(lngRow, 7)
.Cells(vntRet + lngN, 7).Copy objSh.Cells(lngRow, 8)
'ab hier passt auch alles,
objSh.Cells(lngRow, 4) = .Range("B3").Value
objSh.Cells(lngRow, 1) = "OC"
objSh.Cells(lngRow, 12) = "ja"
lngRow = lngRow + 1
End If
Next
End If
End With
End If
End If
objWB.Close False
End If
Next
End If
MsgBox "Der Import ist erfolgt"
ErrExit:
With Err
If .Number  0 Then MsgBox "Fehler " & .Number & vbLf & vbLf & .Description _
& vbLf & vbLf & "In Prozedur (importData) in Modul Modul1", vbExclamation, _
"Fehler in Makro bitte im VBA Code nachsehen"
End With
GMS True
Set objWB = Nothing
Set objSh = Nothing
End Sub

Ich habe auch mal die Datei (objWB), die durchsucht wird sprich importiert wird angefügt.
https://www.herber.de/bbs/user/68241.xls
Über eine antwort würde ich mich sehr freuen.
Viele Grüße aus München,
Jeron
Anzeige
AW: Sumif mit zwei Bedingungen
25.02.2010 11:56:45
jeron
Hallo Sepp,
jetzt funktioniert alles super!
Habe den Bug selbst entdeckt.
Danke nochmal für deine tolle Unterstützung die letzten tage.
Gut, dass es so hilfsbereite und intelligente leute wie dich noch gibt!!
Einen schönen Tag und sonnige Grüße aus München,
Jeron
AW: Sumif mit zwei Bedingungen
24.02.2010 17:06:44
Reinhard
Hallo Sepp/Josef,
was ist dir eigentlich lieber?
Was ist
GMS True
habe ich da eine entsprechende Prozedur übersehen?
Frage noch offen weil der Anfrager sie noch offen wollte.
Gruß
Reinhard
G(et)M(ore)S(peed) owT
24.02.2010 17:08:46
Renee

331 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige