VBA Zellenwert suchen und nebenstehenden ausgeben

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Schönen guten Tag,
ich habe mein Problem einfacher ausgedrückt als es eigentlich ist.
Es geht um eine Tabelle mit mehreren Hundert solcher Hallo's, ebenfalls variiert die Zahl der Zellen die Addiert werden muss.
Folgender Code wird derzeit verwendet: Sub Hallofinden() Dim strSuche As String Dim rngFound As Range Dim strFirstAddress As String Dim i As Long i = 5 strSuche = "Hallo" Set rngFound = Columns(2).Find(What:=strSuche, After:=Cells(Rows.Count, 2), LookIn:=xlValues, _ LookAt:=xlWhole) If rngFound Is Nothing Then Exit Sub strFirstAddress = rngFound.Address Do Cells(i, 4).Value = rngFound.Offset(, 1).Value Set rngFound = Columns(2).FindNext(rngFound) i = i + 1 Loop While rngFound.Address strFirstAddress Dieser Code spuckt bisher alle Nebenstehenden Werte in einem von mir vordefinierten Bereich (ab D5) aus.
Das Makro soll eben die Arbeit, die bisher immer Manuell durchgeführt wurde, abnehmen. Hierzu soll es die "Überschriften" namens "Hallo" finden und alle "Unterpunkte" namens "A,B,C,D..." bis zur nächsten Überschrift addieren und ausgeben.
MfG,
Anton Huber

Hallo,
wir kommen dem ganzen immer näher.
Das Problem ist folgendes:
Wir haben hier ja verschiedene Ebenen - Hallo3 bis Hallo 6.
Die Ebenen sind so gestaffelt, dass Hallo6 ALLE Hallo 5 beinhalten soll, bis die nächste Hallo 6 Ebene beginnt. Dieser Wert ist genauso hoch, wie die Summe aller Werte OHNE Ebene.
Die Ebene Hallo 5 soll alle Hallo4 Ebenen beinhalten, bis die nächste Hallo5 oder Hallo6 Ebene erscheint. Ebenso beinhaltet Hallo5 sogesehen alle Werte OHNE Ebene eben bis zur nächsten gleichen oder höher gestellten Ebene.
Das gleiche Prinzip soll für die Hallo4 Ebene (Alle Hallo3 Ebenen) angewandt werden. Mit dem Makro von Erich G. findet man schon mal alle Hallo3 und addiert die dazugehörigen Werte bis zum nächsten Hallo3, jedoch macht die Funktion nicht bei Hallo4/Hallo5/Hallo6 halt.
Ich denke dass dieser Ansatz der vielversprechendere Ist, da ich ja eine Tabelle bekomme die schon Werte eingetragen hat. Wenn ich darauf eine Formel anwenden muss, überschreibe ich die schon vorhandenen Werte.
Hier nochmal das Makro von Erich G.:

Option Explicit
Sub HalloAdd()
Dim lngQ As Long, arQ, zz As Long, dSum As Double
lngQ = Cells(Rows.Count, 2).End(xlUp).Row
arQ = Cells(1, 1).Resize(lngQ, 2)
For zz = lngQ To 1 Step -1
If arQ(zz, 1) = "Hallo3" Then
Cells(zz, 2) = dSum
dSum = 0
Else
dSum = dSum + Cells(zz, 2)
End If
Next zz
End Sub

Dieses Makro schafft es, die Hallo3 Werte OHNE Ebene bis zum nächsten Hallo3 zu addieren - jedoch macht es leider vor keinem Hallo4/Hallo5/Hallo6 halt.
Es wäre perfekt wenn dieses Makro so umgeschrieben werden könnte, dass zuerst ein Hallo3 gesucht wird und bei Hallo3/Hallo4/Hallo5/Hallo6 gestoppt wird, danach die Hallo4 (Stop bei Hallo4/Hallo5/Hallo6), dann die Hallo5 (Stop bei Hallo5/Hallo6) und zum Schluss die Hallo6 (Stop bei Hallo6).
Ich hoffe ich konnte das ganze verständlich darstellen und drücke mich nicht wirr aus - Ich danke dir/euch schon mal für die aufgebrachte Mühen. Wirklich sehr sehr nett von dir bzw euch allen!
MfG,
Dieter Nasch

Sub Makro1() Const fRow As Long = 2 Dim lRow As Long Const sFrei As Long = 8 'Spalte H ist frei --- oder eine andere Spalte nehmen With ActiveSheet lRow = .Cells(.Rows.Count, 1).End(xlUp).Row .Range(.Cells(fRow, sFrei), .Cells(lRow, sFrei)).FormulaR1C1 = _ "=IF(LEFT(RC[-7],5)=""Hallo"",SUM(R[-1]C[-6]:INDEX(C[-6],IFERROR(ROW()+MATCH(RC[-7],R[1] _ C1:R" & .Rows.Count & "C1,)," & .Rows.Count & "))),RC[-6])" .Cells(1, sFrei).EntireColumn.Copy .Cells(1, 2).PasteSpecial xlPasteValues .Cells(1, sFrei).EntireColumn.ClearContents End With End Sub

Option Explicit Sub HalloAdd() Dim lngQ As Long, arQ, zz As Long, dSum As Double lngQ = Cells(Rows.Count, 2).End(xlUp).Row arQ = Cells(1, 1).Resize(lngQ, 2) For zz = lngQ To 1 Step -1 If arQ(zz, 1) = "Hallo" Then Cells(zz, 2) = dSum dSum = 0 Else dSum = dSum + Cells(zz, 2) End If Next zz End Sub

Beliebteste Forumthreads (12 Monate)

	A	B
1		0,00001
2	Hallo	0,011
3		0,001
4		0,01
5	Hallo	1111
6		1
7		10
8		100
9		1000
10	Hallo	1100000
11		100000
12		1000000
13	Hallo	0
14

VBA Zellenwert suchen und nebenstehenden ausgeben

19
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA Zellenwert suchen und nebenstehenden ausgeben

19 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

19
Beiträge zum Forumthread

Beiträge zu diesem Forumthread