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

Bereich zwischen Zellrahmen suchen

Bereich zwischen Zellrahmen suchen
Malte
Hallo,
mein Grundproblem ist es, eine Suche nach Zellrahmen zu gestalten.
Dabei ist die Tabelle wie folgt aufgebaut (die unterstriche stehen für den dicken unteren Rahmen einer Zelle -> xlEdgeBottom Stärke: xlMedium)
1_______________
2
3
4_______________
5_______________
6
7
8
9
10
11_______________
Nun muss ich die einzelnen Bereiche herausfinden, um mit diesen weiter zu arbeiten, sprich ich bräuchte die Wertepaare
z.b. Zelle 2-4, Zelle 5 und Zelle 6 bis 11.
Meine Idee sieht wie folgt aus (als
Function verpackt)

Function bereich_check()
Dim b As Integer 'Merker
Dim feld(2) As Integer 'Feld 1 = Startzelle ; Feld 2 = Endzelle
Do Until Range("a" & i).Borders(xlEdgeBottom).Weight = xlMedium And b = 2 'Suche bis Linie  _
gefunden ist und b=2 ist
If Range("a" & i).Borders(xlEdgeBottom).Weight = xlMedium Then 'wenn zelle eine dicke    _
_
_
linie hat, dann b hochsetzen und zelle schreiben
feld(b) = i 'Zellen schreiben
b = b + 1
End If
i = i + 1
Loop
feld(1) = feld(1) + 1 ‘Ich suche nach xlBottom, also wenn Zelle 1 die Linie unten hat, ist mein  _
_
_
Bereichsstartwert Zelle 2, also der erste Wert+1
bereich_check = feld 'Übergabewert
End Function

i ist eine globale Variable, damit ich beim erneuten starten des Makros immer wieder weiß wo ich bin (total doofe Lösung)
Das Problem ist, dass die b=2 Bedingung nicht so richtig akzeptiert wird, da er mir immer nur einen Wert ausgibt.
Beim ersten Durchlauf schreibt er die richtigen Werte, dann wenn b=2 läuft er jedoch stumpf weiter und bricht nicht ab, somit sind meine ganzen Werte falsch und es kommt nur noch mumpitz raus. :/
Hat jemand eine Idee?
Vielen Dank!

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Bereich zwischen Zellrahmen suchen
06.03.2012 10:44:37
Rudi
Hallo,
Sub aaa()
Dim strRange As String
strRange = CheckBereich(Range("A1:A100"))
If strRange  "" Then
MsgBox Range(strRange).Address _
& " (" _
& Range(strRange).Areas.Count _
& " Bereiche)"
Else
MsgBox "Keine Rahmen"
End If
End Sub

Function CheckBereich(rngCheck As Range)
Dim rngC As Range, rngStart As Range
For Each rngC In rngCheck
If rngC.Borders(xlEdgeBottom).Weight = xlMedium Then
If rngStart Is Nothing Then
Set rngStart = rngC.Offset(1)
Else
If CheckBereich = "" Then
CheckBereich = Range(rngStart, rngC).Address(0, 0)
Else
CheckBereich = CheckBereich & ", " _
& Range(rngStart, rngC).Address(0, 0)
End If
Set rngStart = rngC.Offset(1)
End If
End If
Next
End Function

Gruß
Rudi
Anzeige
AW: Bereich zwischen Zellrahmen suchen
06.03.2012 11:01:28
Malte
Boh, wahnsinn!
Super! Vielen Dank!
Könntest Du mir kurz erklären, was dein Quellcode macht? So ganz verstehe ich ihn nicht.
speziell dieser part, was passiert da?
If rngStart Is Nothing Then
Set rngStart = rngC.Offset(1)
Else
If CheckBereich = "" Then
CheckBereich = Range(rngStart, rngC).Address(0, 0)
Else
CheckBereich = CheckBereich & ", " _
& Range(rngStart, rngC).Address(0, 0)
End If
Set rngStart = rngC.Offset(1)
Danke dir vieeelmals!
AW: Bereich zwischen Zellrahmen suchen
06.03.2012 11:10:04
Rudi
Hallo,
vielleicht hilft dir das weiter:
Function CheckBereich(rngCheck As Range)
Dim rngC As Range, rngStart As Range
For Each rngC In rngCheck 'alle Zellen im Bereich durchlaufen
If rngC.Borders(xlEdgeBottom).Weight = xlMedium Then
'Zelle hat dicken Rahmen
If rngStart Is Nothing Then 'noch keine Zelle mit Rahmen gefunden dann
Set rngStart = rngC.Offset(1) 'Startzelle setzen
Else
If CheckBereich = "" Then
'Adresse des ersten Bereichs
CheckBereich = Range(rngStart, rngC).Address(0, 0)
Else
'weitere Adressen mit ", " getrennt anhängen
CheckBereich = CheckBereich & ", " _
& Range(rngStart, rngC).Address(0, 0)
End If
Set rngStart = rngC.Offset(1) 'neue Startzelle setzen (1 tiefer)
End If
End If
Next
End Function

Gruß
Rudi
Anzeige
AW: Bereich zwischen Zellrahmen suchen
06.03.2012 11:20:23
Malte
Hallo!
Ja das hilft sehr gut!
ich habe jetzt noch 2 probleme damit :)
1. If CheckBereich = "" Then die Abfrage verstehe ich nicht so ganz, warum soll das Leer sein?
und
2. Kann ich nun die Adressen einzelnen aus diesem "range.adress" herausziehen, damit ich innerhalb des z.B. 1. bereiches die zellen nach werten durchsuchen kann? oder habe ich nun den ganzen batzten auf einmal?
diese range adress, sind leider komplett neu für mich. aber sie scheinen extrem hilfreich zu sein :)
Danke!
AW: Bereich zwischen Zellrahmen suchen
06.03.2012 11:38:09
Rudi
Hallo,
1. klar kann der String "" sein, wenn keine dicken Rahmenlinien da sind.
2. hier mal ein Bsp. zur Summierung der einzelnen Bereiche:
Sub aaa()
Dim strRange As String
Dim myRange As Range, arrSum(), rngC As Range, i As Integer
strRange = CheckBereich(Range("A1:A100")) 'Bereich ermitteln
Set myRange = Range(strRange) 'Bereich setzen
ReDim arrSum(myRange.Areas.Count - 1) 'Array für Summen dimensionieren
For Each rngC In myRange.Areas  'Einzelbereiche durchlaufen
arrSum(i) = Application.Sum(rngC) 'Summe je Bereich bilden
i = i + 1 'Zähler für Array
Next
MsgBox Join(arrSum, ", ") 'Ausgabe für Test
End Sub

Gruß
Rudi
Anzeige
AW: Bereich zwischen Zellrahmen suchen
06.03.2012 11:40:47
Malte
Hm, werde nochmal drüber grübeln und mit den Sachen rumprobieren :) Echt gute Lösungsansätze und wesentlich eleganter als meine.
Vielen Dank!!!!

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige