Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1152to1156
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
Inhaltsverzeichnis

Matrizenberechnung

Matrizenberechnung
Manfred
Hallo zusammen,
ich brauche eure Hilfe bei folgendem Problem:
Ein Arbeitsblatt enthält in den Zellen Einsen oder Nullen. Ich möchte nun herausfinden, ob es zwischen zwei bestimmten Zellen einen "Pfad" von Einsen gibt, der nicht durch eine Null unterbrochen ist. Kann ich das mit einer Formel lösen oder gibt es eine einfache VBA-Lösung?
Vielen Dank im Voraus!
Manfred

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

Betreff
Benutzer
Anzeige
AW: Matrizenberechnung
20.04.2010 09:06:28
Matthias5
Hallo Manfred,
ja das dürfte per Formel gehen. Du könntest per Zählenwenn die Einsen zählen und dann mit der Anzahl Zellen vergleichen. Gib doch mal ein Beispiel.
Gruß,
Matthias
mit VBA ...
20.04.2010 09:16:13
Matthias
Hallo
Userbild
Option Explicit
Sub Manfred()
Dim Bereich As Range, c As Range
Set Bereich = Selection
For Each c In Bereich
 If c.Value = "0" Then MsgBox "getrennt durch mind. eine Null": End
Next
MsgBox "alle Zellen ohne Null"
End Sub
Hier wurde jetzt aber noch nicht auf Einser geprüft !
Gruß Matthias
Anzeige
AW: Matrizenberechnung
20.04.2010 09:21:56
Manfred
Hier ist eine Bespieldatei. Ich möchte feststellen, ob es einen Einserpfad zwischen Zelle C1 und Zelle C12 gibt (Ergebnis: wahr) und ob es einen Pfad zwischen Zelle C1 und Zelle E12 gibt (Ergebnis: falsch).
https://www.herber.de/bbs/user/69161.xls
jetzt wirds unklarer ...
20.04.2010 09:35:45
Matthias
Hallo
Wieso ergibt das Eine WAHR das Andere FALSCH ?
zwischen C1 und C12 stehen "Nullen"
zwischen C1 und E12 stehen auch "Nullen"
Ich persönl. versteh also jetzt nix mehr.
Gruß Matthias
Pfad ?
20.04.2010 10:56:41
Erich
Hi Manfred,
was genau ist ein "Pfad"?
Wenn es eine Kette aneinander grenzender Zellen ist, sehe ich bei beiden Aufgaben das Ergebnis WAHR.
Die gelbe und die dunkelgrüne "Kette" teilen sich den hellgrünen Pfad:
 ABCDE
100100
201110
301010
401011
511000
611100
710011
811110
900010
1000111
1100101
1200101

Habe ich die Aufgabe so richtig verstanden?
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: Pfad ?
20.04.2010 11:18:44
Manfred
Hallo Erich,
ja Du hast die Aufgabenstellung richtig verstanden. Ich habe übersehen, dass es zwischen E12 und C1 auch einen gültigen Pfad gibt.
Grundsätzlich will ich später mehrere Kombinationen zwischen verschiedenen Punkten überprüfen.
Gruß
Manfred
Code-Vorschlag
20.04.2010 12:24:52
Erich
Hi Manfred,
probier mal

Sub start()
MsgBox Pfadfinder(Cells(1, 3), Cells(12, 3))
End Sub
Function Pfadfinder(rngStart As Range, rngZiel As Range) As Boolean
Dim rngS As Range, rngZ As Range, rngA As Range, rngN As Range, rngE As Range
Dim rngC As Range, zC As Long, sC As Long, zz As Long, ss As Long
Dim bolW As Boolean
Set rngA = rngStart
Set rngN = rngA
Set rngZ = rngZiel
bolW = True
While bolW
bolW = False
For Each rngC In rngN
zC = rngC.Row
sC = rngC.Column
For zz = Application.Max(1, zC - 1) To Application.Min(256, zC + 1)
For ss = Application.Max(1, sC - 1) To Application.Min(256, sC + 1)
If Cells(zz, ss) = 1 Then
If rngZ.Address = Cells(zz, ss).Address Then
Pfadfinder = True
Exit Function
End If
If Intersect(Cells(zz, ss), Union(rngA, rngN)) Is Nothing Then
bolW = True
If rngE Is Nothing Then
Set rngE = Cells(zz, ss)
Else
Set rngE = Union(rngE, Cells(zz, ss))
End If
End If
End If
Next ss
Next zz
Next rngC
Set rngA = Union(rngA, rngN)
Set rngN = rngE
Set rngE = Nothing
Wend
End Function
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: Code-Vorschlag
20.04.2010 13:26:20
Manfred
Hi Erich,
das ist ganz toll und funktioniert prima. Vielen Dank. In einer ruhigen Minute werde ich mal den Code analysieren um zu verstehen, was da genau gemacht wird. Zunächst ist mein Problem auf jeden Fall gelöst.
Herzliche Grüße aus Stuttgart
Manfred
Korrektur
20.04.2010 13:47:03
Erich
Hi Manfred,
das hatte ich nicht richtig getestet. Die Fkt. brachte zu oft WAHR.
Hier eine (hoffentlich bessere) Variante:

Function Pfadfinder(rngStart As Range, rngZiel As Range) As Boolean
Dim rngS As Range, rngZ As Range, rngA As Range, rngN As Range, rngE As Range
Dim rngC As Range, zC As Long, sC As Long, ii As Long
Dim bolEnd As Boolean, rngU(1 To 4) As Range, rngV As Range, rngW As Range
Set rngA = rngStart
Set rngN = rngA
Set rngZ = rngZiel
While Not bolEnd
bolEnd = True
For Each rngC In rngN
zC = rngC.Row
sC = rngC.Column
If zC > 1 Then Set rngU(1) = Cells(zC - 1, sC)
If sC > 1 Then Set rngU(2) = Cells(zC, sC - 1)
If zC 
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
ein bisschen kürzer und einfacher
20.04.2010 16:53:59
Erich
Hi Manfred,
hier noch eine etwas kürzere und klarere Variante:

Function Pfadfinder(rngStart As Range, rngZiel As Range) As Boolean
Dim rngS As Range, rngZ As Range, rngA As Range, rngN As Range, rngE As Range
Dim rngC As Range, zC As Long, sC As Long, ii As Long
Dim bolEnd As Boolean, rngU(1 To 4) As Range
Set rngA = rngStart
Set rngN = rngA
Set rngZ = rngZiel
While Not bolEnd
bolEnd = True
For Each rngC In rngN
zC = rngC.Row
sC = rngC.Column
If zC > 1 Then Set rngU(1) = rngC.Offset(-1)
If sC > 1 Then Set rngU(2) = rngC.Offset(, -1)
If zC 
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: ein bisschen kürzer und einfacher
21.04.2010 08:05:33
Manfred
Hallo Erich,
Du hängst Dich ja wirklich richtig rein. Nochmals vielen Dank. Das überarbeitete Skript funktioniert hervorragend!!!
Grüße aus Stuttgart
Manfred
Pfadfinder
23.04.2010 00:24:53
Erich
Hi Manfred,
da hab ich mich doch noch mal reingehängt am späten Abend ;-) und die Prozedur etwas ausgebaut.
Hier wird der gefundene Pfad in einem Array zurückgegeben und kann dann als Liste ausgegeben oder auch eingefärbt werden:
https://www.herber.de/bbs/user/69195.xls
Vielleicht machts ja Spaß.
Rückmeldung wäre nett! - Grüße nach Stuttgart von Erich aus Kamp-Lintfort
Anzeige
=SUMME(A3:A7)=5
20.04.2010 09:19:36
WF
Hi Manfred,
wenn zwischen A2 und A8 (exklusive) nur einser stehen sollen.
Allgemein pro Spalte: kleinere Zelle steht in C3 / höhere in C4:
=SUMME(INDIREKT(LINKS(C3)&TEIL(C3;2;999)+1&":"&LINKS(C4)&TEIL(C4;2;999)-1))=TEIL(C4;2;999)-TEIL(C3;2; 999) -1
Salut WF

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige