Adaption der Addition

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Adaption der Addition von: artur
Geschrieben am: 18.03.2005 09:10:00

Guten morgen,

habe folgendes Problem,
Ich habe ein Makro, welches mir zwei Tabellen vergleicht. Jetzt möchte ich, dass aus einer Tabelle noch die Daten, die in der nebenspalte stehen addiert werden.
siehe Beispiel und hier das Makro

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


Sub Vergleichen()
    Dim LoI As Long
    Dim LoJ As Long
    Dim LoLetzte1 As Long
    Dim LoLetzte2 As Long
    Dim Loletzte3 As Long
    With Worksheets("Verweis")
        LoLetzte1 = IIf(IsEmpty(.Range("A65536")), .Range("A65536").End(xlUp).Row, 65536)
    End With
    With Worksheets("sheet1")
        LoLetzte2 = IIf(IsEmpty(.Range("B65536")), .Range("B65536").End(xlUp).Row, 65536)
    End With
    For LoI = 1 To LoLetzte1
        For LoJ = 1 To LoLetzte2
            ' Leerzellen nicht kennzeichnen
            If Worksheets("Verweis").Cells(LoI, 1) <> "" Then
                If Worksheets("Verweis").Cells(LoI, 1) = Worksheets("sheet1").Cells(LoJ, 2) Then
                    
                    Worksheets("Verweis").Rows(LoI).Copy
                    
                    With Worksheets("Übersicht")
                        Loletzte3 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
                        
                        If Loletzte3 > 65536 Then
                            MsgBox "In Tabelle3 ist keine Zeile mehr frei"
                            Application.CutCopyMode = False
                            Exit Sub
                        End If
                        
                        .Rows(Loletzte3).PasteSpecial Paste:=xlValues           ' Werte
                        .Rows(Loletzte3).PasteSpecial Paste:=xlFormats      ' Formate
                    End With
                    Exit For    ' innere Schleife verlassen da Datensatz gefunden
                End If
            End If
        Next LoJ
    Next LoI
    Application.CutCopyMode = False
End Sub


Vielen Dank

MFG Artur
Bild


Betrifft: AW: Adaption der Addition von: ChrisSp
Geschrieben am: 18.03.2005 09:31:00

Hi Artur,

ich würde hinter den Punkt:
*Worksheets("Verweis").Rows(LoI).Copy*, gleich noch die erfassung der summe packen.
z.b.
startzeile = LoI
summe = 0
do
set c = columns(1).find (what:=Cells(LoI, 2))
if c. row <> startzeile
summe = summe + cells(LoI,2).value
end if
loop until c.row = startzeile


Ich hoffe das ist einigermaßen verständlich???

Gruss

Chris


Bild


Betrifft: AW: Adaption der Addition von: artur
Geschrieben am: 18.03.2005 09:41:22

Hi Chris,

das ist eine gute idee, nur meldet excel, mir einen Syntaxfehler

startzeile = LoI
summe = 0
do
set c = columns(1).find (what:=Cells(LoI, 2))
if c. row <> startzeile -- in dieser Zeile
summe = summe + cells(LoI,2).value
end if
loop until c.row = startzeile

Wo kann der Fehelr liegen

Vielen Dank

MFG

artur


Bild


Betrifft: Wollt dich nur test :o) von: ChrisSp
Geschrieben am: 18.03.2005 09:46:25

... hast natürlich Recht! hinter startzeile kommt noch ein "then", sonst klappts nicht mit der For-Schleife.

Ich hoffe mal ich hab die LoI´s und LoJ´s nicht vertauscht!!!!

Gruss

Chris


Bild


Betrifft: AW: Wollt dich nur test :o) von: artur
Geschrieben am: 18.03.2005 09:50:24

Hi Chris,
habe das auch gemerkt (und wollte dich ebenfalls testen :-)) und die Sache laufen lassen,
es ist irgendwie eine endlosschleife. Excel zeigt keine Rücklmeldung mehr.

MFG

Artur


Bild


Betrifft: AW: Wollt dich nur test :o) von: ChrisSp
Geschrieben am: 18.03.2005 10:09:48

... langsam wird´s ne bisschen peinlich :o)
neuer Versuch - diesmal hab ich´s auch getestet:

startzeile = LoI
summe = Cells(LoI, 2).Value
zeile = LoI
Do
Set c = Columns(1).Find(what:=Cells(LoI, 1), after:=Cells(zeile, 1))
If c.Row <> startzeile Then
summe = summe + Cells(c.Row, 2).Value
zeile = c.Row
End If
Loop Until c.Row = startzeile

Dabei ist mir noch was aufgefalle! Es werden in der Ausgabe alle Werte so oft aufgeführt, wie sie auch vorkommen, also Wert2 z.b. 3mal???? Soll das so, oder soll dann nur stehen Wert2 und die zugehörige Summe?

Gruss

Chris


Bild


Betrifft: AW: Wollt dich nur test :o) von: artur
Geschrieben am: 18.03.2005 10:21:34

Hi Chris

diesmal läufts, aber es soll mir nur den Wert2 anzeigen und die Summe.
Was könnte man ändern?

MFG

Artur


Bild


Betrifft: Schon besser :o) von: ChrisSp
Geschrieben am: 18.03.2005 10:39:00

Hi Artur,

was ist damit?


Sub Vergleichen()
    Dim LoI As Long
    Dim LoJ As Long
    Dim LoLetzte1 As Long
    Dim LoLetzte2 As Long
    Dim Loletzte3 As Long
    Dim c As Object
    
    With Worksheets("Verweis")
        LoLetzte1 = IIf(IsEmpty(.Range("A65536")), .Range("A65536").End(xlUp).Row, 65536)
    End With
    With Worksheets("sheet1")
        LoLetzte2 = IIf(IsEmpty(.Range("B65536")), .Range("B65536").End(xlUp).Row, 65536)
    End With
    For LoI = 1 To LoLetzte1
            ' Leerzellen nicht kennzeichnen
            Set c = Worksheets("Übersicht").Columns(1).Find(what:=Worksheets("Verweis").Cells(LoI, 1).Value, lookat:=xlWhole)
            If Worksheets("Verweis").Cells(LoI, 1).Value <> "" And c Is Nothing Then
                Set c = Worksheets("sheet1").Columns(2).Find(what:=Worksheets("Verweis").Cells(LoI, 1).Value, lookat:=xlWhole)
                If Not c Is Nothing Then
                    startzeile = LoI
                    summe = Worksheets("Verweis").Cells(LoI, 2).Value
                    zeile = LoI
                    Do
                        Set c = Worksheets("Verweis").Columns(1).Find(what:=Worksheets("Verweis").Cells(LoI, 1), after:=Worksheets("Verweis").Cells(zeile, 1), lookat:=xlWhole)
                        If c.Row <> startzeile Then
                            summe = summe + Worksheets("Verweis").Cells(c.Row, 2).Value
                            zeile = c.Row
                        End If
                    Loop Until c.Row = startzeile
                    
                    Worksheets("Verweis").Rows(LoI).Copy
                    With Worksheets("Übersicht")
                        Loletzte3 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
                        
                        If Loletzte3 > 65536 Then
                            MsgBox "In Tabelle3 ist keine Zeile mehr frei"
                            Application.CutCopyMode = False
                            Exit Sub
                        End If
                        
                        .Rows(Loletzte3).PasteSpecial Paste:=xlValues           ' Werte
                        .Rows(Loletzte3).PasteSpecial Paste:=xlFormats      ' Formate
                        .Cells(Loletzte3, 2).Value = summe
                    End With
                End If
            End If
    Next LoI
    Application.CutCopyMode = False
End Sub



Gruss

Chris


Bild


Betrifft: AW: Schon besser :o) von: artur
Geschrieben am: 18.03.2005 10:51:42

Hi Chris,
Tja was soll ich dazu sagen, einfach PERFEKT, läuft wie eine 1. SO habe ich mir das vorgestellt.
Vielleicht, wenn wir schon dabei sind :-), kannst du mir noch einwenig helfen.
Und zwar soll dann in Übersicht noch die Aanzahl der summierten Werte oder der gleichen Daten in in Verweis, in der naächsten Spalte angezeigt werden.
Bei Wert2 wäre das 3 usw.

Vielen DAnk im voraus

MFG

Artur


Bild


Betrifft: beim Level (VBA - gut) etwas übertrieben??? ;o) von: ChrisSp
Geschrieben am: 18.03.2005 11:02:50

das einfachst ist noch ein Zählvariable mit einzubauen, die du jedesmal um 1 erhöhst, wenn du die Summe errechnest z.B. z = z + 1; dabei musst du z immer wieder auf 1 zurücksetzen, also wenn du mit einem neuen Wert (z.b. Wert7) anfängs
vgl. Zeile: *summe = Worksheets("Verweis").Cells(LoI, 2).Value*
wenn du das gemacht hast, musst du das jeweilige Ergebnis nur noch in die Übersicht schreiben, also ebenfalls an der gleichen Stelle, wie die Summe, nur halt eine Spalte weiter!

War das einigermaßen verständlich?

Gruss :o)

Chris


Bild


Betrifft: AW: beim Level (VBA - gut) etwas übertrieben??? ;o) von: artur
Geschrieben am: 18.03.2005 11:12:42

Hi Chris,

vielleicht habe ich mit dem Level einwenig geflunkert. Aber etwas VBA kann ich schon, es gibt halt keine zwischending zwischen nein und gut.
Ich habe das schon verstanden, aber an der Umsetzung happerts halt einwenig, kannst du mir da bitte noch ein letzttes mal helfen?

MFG

Artur


Bild


Betrifft: War auch nur als Spaß gemeint ;o) von: ChrisSp
Geschrieben am: 18.03.2005 11:14:38

Klar schieß los :o)

Chris


Bild


Betrifft: AW: War auch nur als Spaß gemeint ;o) von: artur
Geschrieben am: 18.03.2005 11:25:27

Hi Chris,

ich weiss :-)
KAnnst du das, was du mir oben mit der Anzahl vorgeschlagen hast, in einem code darstellen, damit ich den einbauen kann in mein Gesamtmakro? Ginge das?

MFG

Artur


Bild


Betrifft: AW: War auch nur als Spaß gemeint ;o) von: ChrisSp
Geschrieben am: 18.03.2005 11:29:23

Hi Artur,


Sub Vergleichen()
    Dim LoI As Long
    Dim LoJ As Long
    Dim LoLetzte1 As Long
    Dim LoLetzte2 As Long
    Dim Loletzte3 As Long
    Dim c As Object
    Dim z%
    
    With Worksheets("Verweis")
        LoLetzte1 = IIf(IsEmpty(.Range("A65536")), .Range("A65536").End(xlUp).Row, 65536)
    End With
    With Worksheets("sheet1")
        LoLetzte2 = IIf(IsEmpty(.Range("B65536")), .Range("B65536").End(xlUp).Row, 65536)
    End With
    For LoI = 1 To LoLetzte1
            ' Leerzellen nicht kennzeichnen
            Set c = Worksheets("Übersicht").Columns(1).Find(what:=Worksheets("Verweis").Cells(LoI, 1).Value, lookat:=xlWhole)
            If Worksheets("Verweis").Cells(LoI, 1).Value <> "" And c Is Nothing Then
                Set c = Worksheets("sheet1").Columns(2).Find(what:=Worksheets("Verweis").Cells(LoI, 1).Value, lookat:=xlWhole)
                If Not c Is Nothing Then
                    startzeile = LoI
                    summe = Worksheets("Verweis").Cells(LoI, 2).Value
                    z = 1
                    zeile = LoI
                    Do
                        Set c = Worksheets("Verweis").Columns(1).Find(what:=Worksheets("Verweis").Cells(LoI, 1), after:=Worksheets("Verweis").Cells(zeile, 1), lookat:=xlWhole)
                        If c.Row <> startzeile Then
                            summe = summe + Worksheets("Verweis").Cells(c.Row, 2).Value
                            z = z + 1
                            zeile = c.Row
                        End If
                    Loop Until c.Row = startzeile
                    
                    Worksheets("Verweis").Rows(LoI).Copy
                    With Worksheets("Übersicht")
                        Loletzte3 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
                        
                        If Loletzte3 > 65536 Then
                            MsgBox "In Tabelle3 ist keine Zeile mehr frei"
                            Application.CutCopyMode = False
                            Exit Sub
                        End If
                        
                        .Rows(Loletzte3).PasteSpecial Paste:=xlValues           ' Werte
                        .Rows(Loletzte3).PasteSpecial Paste:=xlFormats      ' Formate
                        .Cells(Loletzte3, 2).Value = summe
                        .Cells(Loletzte3, 3).Value = z
                    End With
                End If
            End If
    Next LoI
    Application.CutCopyMode = False
End Sub


Gruss

Chris


Bild


Betrifft: AW: War auch nur als Spaß gemeint ;o) von: artur
Geschrieben am: 18.03.2005 11:35:42

Hi Chris,

vielen Dank nochmal, funktioniert alles super. Werd das Wochenende damit verbringen mein VBA level etwas zu verbessern und den Code zu verstehen.

MFG

Artur


Bild


Betrifft: AW: War auch nur als Spaß gemeint ;o) von: artur
Geschrieben am: 18.03.2005 13:06:34

Hi Chris,
habe folgendes Sache noch,der Code funktioniert, nur meine eigentliche Tabelle sieht so aus
https://www.herber.de/bbs/user/19832.xls

Der Code ist aber etwas verdreht, und ich bin schon seit 1 Stunde dran um den Code anzupassen und kriegs nicht hin. kannst du mir nochmal helfen?

MFG

Artur


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Adaption der Addition"