Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1272to1276
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 aus 2 anderen Bereichen ermitteln

Bereich aus 2 anderen Bereichen ermitteln
Peter
Guten Tag
In Arbeit mit Bereichen kenne ich UNION und INTERSECT.
Wie kann ich jedoch den Teil eines Bereiches ermitteln, der in einem anderen Bereich nicht enthalten ist?
Beispiel
Bereich A = Range "1: 66")
Bereich B = Range("1:1,20:21")
Bereich C (entspricht der "Differenzgrösse von Bereich A und B nämlich
Range("2:19,22:66")
Wie kann ich mittels VBA den Range C von Range A und B ableiten?
Gruss, Peter

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
Differenz, Komplement von Bereichen
13.08.2012 16:50:40
Bereichen
Hi Peter,
probier mal den fiolgenden Code. Die Fkt. DiffRange() funzt auch,
dauert aber etwas länger:

Option Explicit
Sub RngRest()
Dim rngA As Range, rngB As Range, rngC As Range
Set rngA = Range("1:66")
Set rngB = Range("1:1,20:21")
MsgBox Intersect(rngA, ComplMulti(rngB)).Address
'   MsgBox DiffRange(rngA, rngB).Address
End Sub
Function ComplMulti(rngS As Range) As Range ' Komplement einer Mehrfachmarkierung
' www.online-excel.de/fom/fo_read.php?f=1&bzh=43557&h=43489#a123x
Dim rngX As Range, rngC As Range
For Each rngX In rngS.Areas
Set rngC = ComplRect(rngX)
If Not rngC Is Nothing Then
If ComplMulti Is Nothing Then
Set ComplMulti = rngC
Else
Set ComplMulti = Intersect(ComplMulti, rngC)
End If
End If
Next rngX
End Function
' Komplement eines Rechteck-Bereichs zurück
Function ComplRect(rngA As Range) As Range
Dim zv As Long, zb As Long, sv As Long, sb As Long, rngT As Range
zv = rngA.Row:       zb = zv + rngA.Rows.Count - 1
sv = rngA.Column:    sb = sv + rngA.Columns.Count - 1
If zv > 1 Then Set rngT = Range(Rows(1), Rows(zv - 1))
If zb  1 Then
If rngT Is Nothing Then
Set rngT = Range(Cells(zv, 1), Cells(zb, sv - 1))
Else
Set rngT = Union(rngT, Range(Cells(zv, 1), Cells(zb, sv - 1)))
End If
End If
If sb 
Im Code stehen zwei Links zu online-excel , da kannst du ja auch noch mal stöbern...
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich
Anzeige
AW: Differenz, Komplement von Bereichen
13.08.2012 21:22:46
Bereichen
Hallo Erich
Vielen Dank. Die erste Version ist wirklich sehr schnell.
Ich habe mir behelfsmässig heute nachmittags auch etwas zusammengebastelt. Damit mein Code nicht wahnsinnig viel Ranges abarbeiten muss, habe ich mir anstelle von Range("1:66"), welcher ja eine Unmenge Spalten umfasst, mit USEDRANGE beholfen.
Nochmals dankeschön und freundlicher Gruss, Peter
Sub RngRest_PS()
Dim rngA As Range, rngB As Range, rngC As Range
''''Set rngA = Range("1:66")
Set rngB = Range("1:1,20:21")
Debug.Print rNotUnion(rngB, ActiveSheet.Name).Address
MsgBox rNotUnion(rngB, ActiveSheet.Name).Address
End Sub
Public Function rNotUnion(rngPart As Range, strWS As String) As Range
Dim rAll As Range, rPart As Range, rErgebnis As Range
Set rAll = Sheets(strWS).UsedRange
Set rPart = Intersect(Sheets(strWS).UsedRange, rngPart)
Set rNotUnion = NotUnion(rAll, rPart).EntireRow
Debug.Print rNotUnion.Address(0, 0)
End Function
'ps
Public Function NotUnion(rngBereich As Range, rngEntfernen As Range) As Range
Dim rngZelle As Range
For Each rngZelle In rngBereich
If Intersect(rngEntfernen, rngZelle) Is Nothing Then
If NotUnion Is Nothing Then
Set NotUnion = rngZelle
Else
Set NotUnion = Union(NotUnion, rngZelle)
End If
End If
Next rngZelle
End Function

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige