Matrix durchsuchen, verketten wenn Beding. erfüllt

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub heike() Dim arr, i As Integer, j As Integer, s As String arr = Range("A1:AI55") For i = 2 To 55 For j = 2 To 35 If arr(i, j) 0 Then s = s & arr(i, 1) & "/" & arr(1, j) & vbLf End If Next Next s = Left(s, Len(s) - 1) With Cells(57, 1) 'Ergebnis in A57 .Value = s .WrapText = True End With End Sub

Sub heike() Dim arr, i As Integer, j As Integer, s arr = Range("A1:AI55") For i = 2 To 55 For j = 2 To 35 If arr(i, j) 0 Then s = s & arr(i, 1) & "/" & arr(1, j) & vbLf End If Next Next s = Split(s, vbLf) Cells(57, 1).Resize(UBound(s) + 1) = _ Application.Transpose(s) 'Ergebnis ab A57 End Sub

Sub heike() Dim arr, i As Integer, j As Integer, s arr = Range("A1:AI55") For i = 2 To 55 For j = 2 To 35 If arr(i, j) 0 Then s = s & arr(i, 1) & "/" & arr(1, j) & vbLf End If Next Next If Len(s) Then s = Split(s, vbLf) Cells(57, 1).Resize(UBound(s) + 1) = _ Application.Transpose(s) 'Ergebnis ab A57 Else MsgBox "nix gefunden" End If End Sub

Sub heike() Dim arr, i As Integer, j As Integer, s, t arr = Range("A1:AI55") For i = 2 To 55 For j = 2 To 35 If arr(i, j) 0 Then s = s & arr(i, 1) & "/" & arr(1, j) & vbLf t = t & arr(i, j) & vbLf End If Next Next If Len(s) Then s = Split(s, vbLf) t = Split(t, vbLf) Cells(57, 1).Resize(UBound(s) + 1) = _ Application.Transpose(s) 'Ergebnis ab A57 Cells(57, 2).Resize(UBound(t) + 1) = _ Application.Transpose(t) Else MsgBox "nix gefunden" End If End Sub

…Heike… :-|
Und was ist, wenn du Gleiches oder Ähnliches in anderer Tabelle oder anderem Zusammenhang nochmal benötigst? Musst du dann wieder fragen, weil du es nicht anpassen kannst?!
Allmählich hast du dann eine hübsche Sammlung von „Eintagsfliegen“ zusammen — dein Nachfolger wird sich freuen, vor allem, falls das alles nicht ordentlich dokumentiert sein sollte!
VBA sollte in 1.Linie dafür benutzt wdn, entweder komplette Projekte zu automatisieren oder Hilfsmittel für ständig wiederkehrende Aufgaben zV zu haben. Ein Sonderfall sind dabei universelle UDFs, die nicht angepasst wdn müssen und das Funktionsinventar von Xl sinnvoll ergänzen. Diese kann man dann auch in AddIns zu allgemeiner u/o ständiger Verwendung stationieren.
Übrigens, „danke“ für das Ignorieren meiner AW! :-[
Luc :-?

…Heike,
kannst du auch dieses Angebot (nur Ergebnis1) nutzen, das allerdings UDFs verwendet:

	A	B	C	D
45		Sp1	Sp2	Sp3
46	x	0	0	7
47	y	0	0	0
48	z	5	0	0
49	Ergebnis1	zSp1	xSp3
50	Ergebnis2	xSp3	zSp1
51	Ergebnis3	xSp3	zSp1
52	B49:C49: {=Splitt(MxJoin(WENN(B46:D48>0;T(INDIREKT(ADRESSE(ZEILE(B46:D48);1)))&
53	T(INDIREKT(ADRESSE(45;SPALTE(B46:D48))));"");" "))}
54	B50:C50: {=INDIREKT(ADRESSE(ZEILE(INDEX(ChooseIf(B46:D48;;0;">");0;0;{1.2}));1;4))&
55	INDIREKT(ADRESSE(45;SPALTE(INDEX(ChooseIf(B46:D48;;0;">");0;0;{1.2}));4))}
56	B51:C51: {=T(JETZT())&Compute("A"&Splitt(MaskOn(RAddress(ChooseIf(B46:D48;;0;">"));"num"))&
57	"&"&Splitt(MaskOn(RAddress(ChooseIf(B46:D48;;0;">"));"GB"))&45)}

Die beiden in Ergebnis1 verwendeten UDFs Splitt und MxJoin findest du im Archiv (Button RECHERCHE, UDF-Namen als Suchbegriff verwenden).
Da der Thread mit MxJoin bei Recherchen oft nicht vollständig angezeigt wird, hier noch der direkte Link.
Gruß, Luc :-?
Besser informiert mit …

Beliebteste Forumthreads (12 Monate)

Matrix durchsuchen, verketten wenn Beding. erfüllt

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Matrix durchsuchen, verketten wenn Beding. erfüllt

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread