Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

erster und letzter Wert einer For Schleife

Betrifft: erster und letzter Wert einer For Schleife von: Wolfi
Geschrieben am: 18.09.2004 11:30:44


Hallo Zusammen und einen schönen Samstag,

ich muss mich leider nochmals an Euch wenden, da ich nicht weiter komme:
For Each rw1 In Workbooks("Mappe1.xls").Worksheets("Process").Rows
Tp = rw1.Cells(4)
Zeile = rw1.Row


If Tp = "PPManufacturingSolution" Then
Zeile = Zeile + 1
Tp = Range("D" & Zeile)
rw2 = rw1.Row


For Each rw2 In Workbooks("Mappe1.xls").Worksheets("Process").Rows
Tp = Range("D" & Zeile)
If Tp = "PPPhase" Then
test = Application.WorksheetFunction.Mode(Range("A" & Zeile & ":A" & Zeile))


Zeile = Zeile + 1
ElseIf Tp <> "PPPhase" Then
Exit For
End If
Next rw2

Zeile = rw1.Row
With Cells(Zeile, 3)
.Value = Left(test, Len(test) - 1)
End With


End If
Tphase = ""
Zähle = 0
If Range("D" & Zeile + 1) = "" Then
Exit For
End If

Next rw1

Mit der Formel Application.WorksheetFunction.Mode möchte ich immer den Häufigsten Wert beim For Schleifendurchlauf ermitteln wenn das Kriterium Tp= PPPhase erfüllt ist.

Mein Problem ich bekomm es nicht hin den Range Bereich der Formel zu bestimmen, da er Variabel sein muss:
Also z.B. wenn Die Forschleife zum ersten mal durchlaufen wird kann der Range bereich nur eine Zelle enthalten z.B Range("C5")

beim weiteren durchlauf aber z.B. wären es die Zellen 8 bis 9 also Rang("C8:C9")

d.h. der Range Bereich ist immer Variabel.

Ich bräuchte also immer den ersten Wert der Schleife und den Letzten. Diese könnte ich dann als den Range Bereich definieren.

Aber wie??????

Gruß und vielen Dank Wolfi

PS zu diesem Thema gibt es schon einige Beiträge von mir aber leider konnte mir noch niemand weiter helfen.


  


Betrifft: AW: erster und letzter Wert einer For Schleife von: Reinhard
Geschrieben am: 18.09.2004 12:55:43

Hi Wolfi,
beim nächsten Mal bitte eine komplette Sub posten, inklusive Einrückungen für If unf For usw. So ist es nicht zu lesen.
Bezogen auf diese Datei: https://www.herber.de/bbs/user/11029.xls
ist der nachfolgende Code die Lösung.
Im Abschnitt6 gibt es ein Problem, 3910140 und 3910160 kommen je 2mal vor, wer soll der häufigste sein? Beide, der erste, der größere Wert?
Gruß
Reinhard

Da vBA nein, zur groben Erläuterung. In dem With-Block werden in pos() alle Zeilennummern gespeichert in denen "Summe" steht. Die Nummer die 2 zeilen unterhalb des Tabellenendes ist, wird dabei auch als Zeile mit "Summe" gespeichert um nachhe einfacher rechnen zu können.
In der For-Schleife wird dann jeweils die Summe zwischen den einzelenen pos() gebildet, sowie die Häufigkeit.
Bei nur einem Wert ergibt die Häufigkeit einen Fehler deshalb noch die If-Abfrage in der For-Schleife.
Option Base 1
Sub tt()
Dim pos()
anz = 0
ges = Worksheets("Tabelle1").Range("a65536").End(xlUp).Row
With Worksheets(1).Range("a1:a" & ges)
    Set c = .Find("Summe", LookIn:=xlValues)
    If Not c Is Nothing Then
        Do
            anz = anz + 1
            ReDim Preserve pos(anz)
            pos(anz) = c.Row
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Row <> pos(1)
    End If
    ReDim Preserve pos(anz + 1)
    pos(anz + 1) = ges + 2
End With
For n = 1 To anz
    Worksheets("Tabelle1").Cells(pos(n), 2) = _
                WorksheetFunction.Sum(Range(Cells(pos(n) + 1, 2), Cells(pos(n + 1) - 2, 2)))
    If pos(n + 1) - pos(n) > 3 Then
        Worksheets("Tabelle1").Cells(pos(n), 3) = _
                WorksheetFunction.Mode(Range(Cells(pos(n) + 1, 3), Cells(pos(n + 1), 3)))
    Else
        Worksheets("Tabelle1").Cells(pos(n), 3) = Worksheets("Tabelle1").Cells(pos(n) + 1, 3)
    End If
Next n
End Sub



  


Betrifft: AW: erster und letzter Wert einer For Schleife von: Wolfi
Geschrieben am: 18.09.2004 14:03:41

Hallo Reinhard,

ich bin begeistert. Jetzt komm ich vielleicht mit meinem Problem endlich weiter. Juhu.

Ich hab nur den Auszug aus dem Code sowie der Tabelle gepostet, damit ich mein Problem überhaupt irgendwie verständlich machen kann.

Aber es ist natürlich kein Problem den ganzen Code und die ganze Datei zu posten.
Falls es gleich viele Arbeitsplätze gibt soll der erste genommen werden.

https://www.herber.de/bbs/user/11033.xls

Function wz()
On Error Resume Next
Workbooks("Mappe1.xls").Worksheets("Process").Activate

If Err.Number = 9 Then
  f = MsgBox("Sie müssen zuerst einen MDM Export ausführen", _
  vbQuestion + vbYesNo)
  If f = 9 Then
  Exit Function
  End If
  
End If

n = "Process Type"

    Dim s
    Dim myC As Excel.Range
    Dim wkb As Workbook, wks As Worksheet
    Set wkb = Workbooks("Mappe1.xls")
    Set wks = wkb.Worksheets("Process")
    With wks.UsedRange

    Set myC = Workbooks("Mappe1.xls").Worksheets("Process").Range("1:1").Find(what:=n, lookat:=xlWhole)

    If Not myC Is Nothing Then
    s = myC.Column
   
    Else
    s = ""
    End If


o = "Process Type"
    End With
    
    Dim G1
    Dim myCG1 As Excel.Range
    Dim wkbG1 As Workbook, wksG1 As Worksheet
    Set wkbG1 = Workbooks("Mappe1.xls")
    Set wksG1 = wkbG1.Worksheets("Process")
    With wksG1.UsedRange

    Set myCG1 = Workbooks("Mappe1.xls").Worksheets("Process").Range("1:1").Find(what:=o, lookat:=xlWhole)

    If Not myCG1 Is Nothing Then
    G1 = Left(myCG1.EntireColumn.Address(0, 0), InStr(myCG1.EntireColumn.Address(0, 0), ":") - 1)
    
    Else
    G1 = ""
    End If

    End With
    

    
    m = "Workcenter"

    Dim G
    Dim myCG As Excel.Range
    Dim wkbG As Workbook, wksG As Worksheet
    Set wkbG = Workbooks("Mappe1.xls")
    Set wksG = wkbG.Worksheets("Process")
    With wksG.UsedRange

    Set myCG = Workbooks("Mappe1.xls").Worksheets("Process").Range("1:1").Find(what:=m, lookat:=xlWhole)

    If Not myCG Is Nothing Then
    G = Left(myCG.EntireColumn.Address(0, 0), InStr(myCG.EntireColumn.Address(0, 0), ":") - 1)
    
    Else
    G = ""
    End If

    End With
    
    
    



Zeile = 2
Tstage = ""
Tphase = ""
Zähle = 0
For Each rw1 In Workbooks("Mappe1.xls").Worksheets("Process").Rows
Tp = rw1.Cells(s)
Zeile = rw1.Row

            
            If Tp = "PPManufacturingSolution" Then
            Zeile = Zeile + 1
            Tp = Range(G1 & Zeile)
                rw2 = rw1.Row
                
                For Each rw2 In Workbooks("Mappe1.xls").Worksheets("Process").Rows
                
                Tp = Range(G1 & Zeile)
                
                
                
             
                
                
                
                If Tp = "PPPhase" Then
                
                Zähle = Zähle + 1
                'Debug.Print rw1.Row
                Debug.Print Zähle
                test = Application.WorksheetFunction.Mode(Range("A" & Zeile & ":A" & Zeile))
               
               
                Zeile = Zeile + 1
                
                
                ElseIf Tp <> "PPPhase" Then
                Exit For
                End If
                
                Next rw2
            
                Zeile = rw1.Row
                With Cells(Zeile, 5)
                .Value = Left(test, Len(test) - 1)
                End With
                
               
            End If
    Tphase = ""
    Zähle = 0
    If Range(G1 & Zeile + 1) = "" Then
    Exit For
    End If
    
Next rw1

End Function



So jetzt werd ich mich mal daran machen Dein Forschlag zu verstehen. Aber das kann etwas dauern.....

Falls Du noch Fragen hast oder etwas nicht versehst Fragen

Gruß Wolfi

Vielen dank für Deine Hilfe ich war schon ziemlich am verzweifeln.




  


Betrifft: O.T. erster und letzter Wert einer For Schleife von: Reinhard
Geschrieben am: 18.09.2004 14:41:38

Hi Wolfi,
habe mich missverständlich ausgedrückt. Wenn der Rest der Sub mit Sicherheit unwichtig ist, klar lieber weglassen, da er sonst den Code längt.
Ich mache in so Fällen einfach eine eigenständige Sub aus dem Code wo das Problem steckt, denn durch das Wort "Sub" ünbernimmt Hans automatisch die Einrückungen.
Gruß
Reinhard


  


Betrifft: AW: O.T. erster und letzter Wert einer For Schleife von: Wolfi
Geschrieben am: 20.09.2004 23:21:31

Guten Abend,

ich hab inzwischen mir den Code angeschaut und an meine Tabelle angepasst. Das ging einwandfrei, obwohl ich den Code leider noch nicht ganz verstanden habe (die Funktion ReDim Preserve). Klar ist es werden die Summen zwischengespeichert, aber wie kann ich die Funktion bei anderen Fällen anwenden. (Also allgemein), ist mir noch nicht klar.

Aber vor allem: Vielen Dank für Deine Hilfe. Damit hab ich mein größtes Problem lösen können.

Gruß Wolfi


  


Betrifft: AW: O.T. erster und letzter Wert einer For Schleife von: Wolfi
Geschrieben am: 21.09.2004 19:02:22

Hallo Reihard,

ich muss leider nochmals um Deine Hilfe bitten:

Ich hab das ganze nun einige Male getestet es läuft auch gut. Bis auf einen Fall:

Drei unterschiedliche Nummern in einem Abschnitt.
Hier gibt es einen Fehler mit der zweiten Funktion (natürlich kann sie keinen Häufigsten Wert ermitteln).
Was muss ich machen das hier der erste Platz verwendet wird.

Gruß Wolfi

Code:

Sub Workcenter()
Dim pos()
Dim wks As Workbook
Dim wk
Set wks = ActiveWorkbook
anz = 0
ges = Worksheets("Process").Range("af65536").End(xlUp).Row
With Worksheets("Process").Range("AF1:AF" & ges)
    Set c = .Find("PPManufacturingSolution", LookIn:=xlValues)
    If Not c Is Nothing Then
        Do
            anz = anz + 1
            ReDim Preserve pos(anz)
            pos(anz) = c.Row
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Row <> pos(1)
    End If
    ReDim Preserve pos(anz + 1)
    pos(anz + 1) = ges + 2
End With
For n = 1 To anz
    Worksheets("Process").Cells(pos(n), 4) = _
                WorksheetFunction.Sum(Range(Cells(pos(n) + 1, 4), Cells(pos(n + 1) - 2, 4)))
    If pos(n + 1) - pos(n) > 3 Then
        Worksheets("Process").Cells(pos(n), 5) = _
                WorksheetFunction.Mode(Range(Cells(pos(n) + 1, 5), Cells(pos(n + 1), 5)))
    Else
        Worksheets("Process").Cells(pos(n), 5) = Worksheets("Process").Cells(pos(n) + 1, 5)
    End If
Next n
End Sub



  


Betrifft: AW: O.T. erster und letzter Wert einer For Schle von: Reinhars
Geschrieben am: 21.09.2004 20:03:17

Hi Wolfi,
ungetestet, probier mal:
Option Base 1
Sub tt()
Dim pos()
anz = 0
ges = Worksheets("Tabelle1").Range("a65536").End(xlUp).Row
With Worksheets(1).Range("a1:a" & ges)
    Set c = .Find("Summe", LookIn:=xlValues)
    If Not c Is Nothing Then
        Do
            anz = anz + 1
            ReDim Preserve pos(anz)
            pos(anz) = c.Row
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Row <> pos(1)
    End If
    ReDim Preserve pos(anz + 1)
    pos(anz + 1) = ges + 2
End With
For n = 1 To anz
    On Error GoTo Fehler
    Worksheets("Tabelle1").Cells(pos(n), 2) = _
                WorksheetFunction.Sum(Range(Cells(pos(n) + 1, 2), Cells(pos(n + 1) - 2, 2)))
    Worksheets("Tabelle1").Cells(pos(n), 3) = _
                WorksheetFunction.Mode(Range(Cells(pos(n) + 1, 3), Cells(pos(n + 1), 3)))
Weiter:
Next n
Exit Sub
Fehler:
Worksheets("Tabelle1").Cells(pos(n), 3) = Worksheets("Tabelle1").Cells(pos(n) + 1, 3)
GoTo Weiter
End Sub

Gruß
Reinhard


  


Betrifft: AW: O.T. erster und letzter Wert einer For Schle von: Wolfi
Geschrieben am: 22.09.2004 19:56:17

Guten Abend Reinhard,

hab den Code heute getestet aber der Fehler ist unverändert vorhanden.
Ich hab mir heute Überlegt, dass es besser ist , wenn es gleich viele Arbeitsplätze gibt oder drei verschiedene, es besser ist, selbst auszuwählen welcher Arbeitsplatz genommen werden soll.
Hab hierzu auch schon etwas hinbekommen.
Für den Fall das es drei unterschiedliche Plätze gibt. Hab ich fast schon eine Lösung hin bekommen. Aber leider nur Fast.

Ich schaff es die drei Arbeitsplätze zu ermitteln und in eine Combobox zu übergeben, aber leider wird dann der ausgewählte nicht mehr zurück gegeben.
Das Ganze funktioniert leider auch nur bei einem Abschnitt mit drei verschiedenen Arbeitsplätzen. Sobald ich einen weiteren Abschnitt mit drei verschiedenen habe, kommt wieder der Fehler in der Funktion der Häufigkeit.

Wie ich das ganze für gleich viele Arbeitsplätze mach ist mir noch schleierhaft.
Hier mein Code.

Sub Workcenter()
Dim pos()
Dim wks As Workbook
Dim wk
Set wks = ActiveWorkbook
anz = 0
ges = Worksheets("Process").Range("a65536").End(xlUp).Row
With Worksheets(1).Range("a1:a" & ges)
    Set c = .Find("Summe", LookIn:=xlValues)
    If Not c Is Nothing Then
        Do
            anz = anz + 1
            ReDim Preserve pos(anz)
            pos(anz) = c.Row
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Row <> pos(1)
    End If
    ReDim Preserve pos(anz + 1)
    pos(anz + 1) = ges + 2
End With
For n = 1 To anz
On Error GoTo Fehler
    Worksheets("Process").Cells(pos(n), 2) = _
                WorksheetFunction.Sum(Range(Cells(pos(n) + 1, 2), Cells(pos(n + 1) - 2, 2)))
    
    If pos(n + 1) - pos(n) > 3 Then
        Worksheets("Process").Cells(pos(n), 3) = _
                WorksheetFunction.Mode(Range(Cells(pos(n) + 1, 3), Cells(pos(n + 1), 3)))
    Else
    
    Worksheets("Process").Cells(pos(n), 3) = Worksheets("Process").Cells(pos(n) + 1, 3)




Fehler:
       
       If pos(n + 1) - pos(n) = 3 Then
       Worksheets("Process").Cells(pos(n), 3) = Worksheets("Process").Cells(pos(n) + 1, 3)
       'Worksheets("Process").Cells(pos(n), 3) = "Ja"
       'If pos(n + 1) - pos(n) = 5 Then
        Else
        'Worksheets("Process").Cells(pos(n), 3) = "3"
        'Worksheets("Process").Cells(pos(n), 3) = Worksheets("Process").Cells(pos(n) + 1, 3)
       test = Worksheets("Process").Cells(pos(n) + 1, 3)
       test1 = Worksheets("Process").Cells(pos(n) + 2, 3)
       test2 = Worksheets("Process").Cells(pos(n) + 3, 3)
       
       

        UserForm1.ComboBox1.List = Array(test, test1, test2)
        UserForm1.Show
        Worksheets("Process").Cells(pos(n), 3) = UserForm1.ComboBox1.Value
        
        
       'VBA.MsgBox "Wählen Sie den Arbeitsplatz:" & VBA.vbCrLf & _
        '                                          test & "  oder  " & VBA.vbCrLf & _
         '                                         test1 & "  oder  " & VBA.vbCrLf & _
          '                                        test2, vbInformation
        '
        
        End If
        
    
       'Worksheets("Process").Cells(pos(n), 3) = "Ja"
       'Worksheets("Process").Cells(pos(n) + 1, 3)
    End If
Next n
End 
Sub    


Bitte Bitte könntest Du mir hierbei noch Helfen.

Gruß Wolfi



  


Betrifft: AW: O.T. erster und letzter Wert einer For Schle von: Reinhard
Geschrieben am: 22.09.2004 20:52:47

Hi wolfi,
ich find diesen Threat schon zu lang, deshalb habe ich die Frage nicht auf noch offen gesetzt.
Vorschlag, du stellst einen neue Frage, dabei eine Datei mithochladen und einen Verweis auf dieses Threat. In die Frage kanst du ja den Tet von eben mit reinnehmen, ggfs ergänzen, oder auch kürzen :-)
Gruß
Reinhard


  


Betrifft: AW: O.T. erster und letzter Wert einer For Schle von: Wolfi
Geschrieben am: 22.09.2004 23:00:32

Ok Beitrag hab ich neu erstellt.

Gruß und Danke olfi


 

Beiträge aus den Excel-Beispielen zum Thema "erster und letzter Wert einer For Schleife"