Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 21:09:11
4 Spalten aus smarter Tabelle in andere smarte Tab. kopieren
18.04.2024 20:45:35
Worksheet_Activate für alle Sheets
18.04.2024 19:30:20
VBA - Tabelle mit Mannschaftsergebnissen sortieren
18.04.2024 18:04:29
Formel fehler Wert#
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
584to588
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
584to588
584to588
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Adaption der Addition

Adaption der Addition
18.03.2005 09:10:00
artur
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

15
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Adaption der Addition
18.03.2005 09:31:00
ChrisSp
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
AW: Adaption der Addition
18.03.2005 09:41:22
artur
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
Anzeige
Wollt dich nur test :o)
18.03.2005 09:46:25
ChrisSp
... 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
AW: Wollt dich nur test :o)
18.03.2005 09:50:24
artur
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
AW: Wollt dich nur test :o)
18.03.2005 10:09:48
ChrisSp
... 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
Anzeige
AW: Wollt dich nur test :o)
18.03.2005 10:21:34
artur
Hi Chris
diesmal läufts, aber es soll mir nur den Wert2 anzeigen und die Summe.
Was könnte man ändern?
MFG
Artur
Schon besser :o)
18.03.2005 10:39:00
ChrisSp
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
Anzeige
AW: Schon besser :o)
18.03.2005 10:51:42
artur
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
beim Level (VBA - gut) etwas übertrieben? ;o)
18.03.2005 11:02:50
ChrisSp
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
Anzeige
AW: beim Level (VBA - gut) etwas übertrieben? ;o)
18.03.2005 11:12:42
artur
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
War auch nur als Spaß gemeint ;o)
18.03.2005 11:14:38
ChrisSp
Klar schieß los :o)
Chris
AW: War auch nur als Spaß gemeint ;o)
18.03.2005 11:25:27
artur
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
AW: War auch nur als Spaß gemeint ;o)
18.03.2005 11:29:23
ChrisSp
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
Anzeige
AW: War auch nur als Spaß gemeint ;o)
18.03.2005 11:35:42
artur
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
AW: War auch nur als Spaß gemeint ;o)
18.03.2005 13:06:34
artur
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

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige