Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 10:38:52
Bedingte Formatierung per VBA / MaxPoint
25.04.2024 10:30:04
Suche mit MINWENNS und Rückgabe mehrerer Werte
25.04.2024 09:47:49
Daten aus mehreren Dateien untereinander importieren
25.04.2024 09:31:31
Bild "In Zelle platzieren"
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
768to772
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
768to772
768to772
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Schnittmenge markieren

Schnittmenge markieren
02.06.2006 08:31:23
Frank
Hallo,
ich habe eine Tabelle deren Daten mit den Daten einer bestimmten Zeile (Zeile 1)verglichen werden. Stimmen Felder (A1, B1, C1) mit den Inhalten der Tabelle überein, werden diese Felder in der Tabelle markiert. Es werden also immer Drei Felder markiert.
Wenn jetzt zum Beispiel in meiner Tabelle die Zellen D14 und A20 farblich markiert werden möchte ich deren Schnittmenge, also das Feld D20 ebenfals markieren.
Ich weiss zwar grundsätzlich wie ich bei fest vorgegebenen Bereichen diese Schnittmenge markieren kann aber nicht in meinem Fall, da dort ja die markierten Felder und somit die Schnittmenge auch ständig wechseln.
Ich habe den Teil des Codes indem die Zeile 1 abgefragt und mit dem Inhalt der Tabelle verglichen wird mal beigefügt.
TabelleUmsack:
Dim arrNumbers() As Variant
Dim intCounter As Integer
Dim i As Integer
Dim c As Range
' Anzahl benötigter Arrayfelder
intCounter = Rows(1).End(xlToRight).Column
' Array-Dimension festlegen
ReDim arrNumbers(intCounter)
' Array-Felder füllen
For i = 1 To intCounter
arrNumbers(i) = Cells(1, i)
Next i
' Hintergrundfarbe des Bereiches zurücksetzen
Range("A13:G27").Interior.ColorIndex = -4142
Range("A29:G43").Interior.ColorIndex = -4142
Range("H13:N27").Interior.ColorIndex = -4142
' Felder vergleichen - Treffer grau hinterlegen
For i = LBound(arrNumbers) To UBound(arrNumbers)
For Each c In Range("A13:G27")
If c.Value = arrNumbers(i) Then
c.Interior.ColorIndex = 6
End If
Next c
Next i
Exit Sub

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Schnittmenge markieren
02.06.2006 09:33:24
fcs
Hallo Frank,
würdest du bitte genauer beschreiben, welche Bedingungen/Kriterien erfüllt sein müssen, damit eine dritte Zelle die Schnittmenge zweier anderer farblich markierter Zellen (d.h Zellen, deren Wert einem Zellinhalt aus der Zeile1 entsprechen) ist.
Eine kleine Beispieltabelle hochzuladen wäre auch hilfreich.
mfg
Franz
AW: Schnittmenge markieren
02.06.2006 11:03:02
Frank
Hallo,
anbei die Tabelle. Sowie die Tabelle jetzt aussieht müsste die Zelle D25 als Schnittmenge markiert werden. Ich habe die Tabelle unter
www.herber.de/bbs/user/34110.xls aufgespielt.
Vielen Dank und Grüße
Frank Zimmermann
AW: Schnittmenge markieren
02.06.2006 12:12:59
Peter
Servus Frank,
du hast in deinem Macro viel zu kompliziert gedacht, die ganzen Schleifen sind unnötig.
Jetzt nur mal auf die schnelle, es gibt in xls wunderbare Hausmittel (Funktionen) die du auch in VBA anwenden kannst z.B. Vergleich(Match). Mal der Code als Bsp. inkl. Scnittmenge.


Option Explicit
Option Base 1
Sub Zellabfrage()
    Dim strKarArr(): Dim str2Arr(): Dim lngGewArr()
    Dim intFind(0 To 1) As Integer
    strKarArr = Array("Umsack", "Umkarton", "Düsseldorfer Karton", "Pfandkiste")
    str2Arr = Array("Netz/RS", "CarryFresh", "Folie")
    lngGewArr = Array(0.5, 0.75, 1, 1.5, 2, 2.5, 3, 4, 5, 10, 12.5, 25)
    Range("D10") = strKarArr(Range("AA7"))
    Range("J10") = str2Arr(Range("AB7"))
    Range("I10") = lngGewArr(Range("AC16"))
    Range("A13:G27").Interior.ColorIndex = -4142
    Range("A29:G43").Interior.ColorIndex = -4142
    Range("H13:N27").Interior.ColorIndex = -4142
    With Application.WorksheetFunction
        If Range("D10") = "Umsack" Or Range("D10") = "Düsseldorfer Karton" Then
            'Nach Karton suchen
            Cells(13, .Match(Range("D10"), Range("A13:G13"), 0)).Interior.ColorIndex = 7
            'Nach dem 2. suchen
            intFind(0) = .Match(Range("J10"), Range("A14:G14"), 0)
            Cells(14, intFind(0)).Interior.ColorIndex = 7
            intFind(1) = Range("AC16") + 15
            Cells(intFind(1), 1).Interior.ColorIndex = 7
        End If
        If Range("d10") = "Umkarton" Or Range("d10") = "Pfandkiste" Then
            Cells(29, .Match(Range("D10"), Range("A29:G29"), 0)).Interior.ColorIndex = 7
            intFind(0) = .Match(Range("J10"), Range("A30:G30"), 0)
            Cells(30, intFind(0)).Interior.ColorIndex = 7
            intFind(1) = Range("AC16") + 31
            Cells(intFind(1), 1).Interior.ColorIndex = 7
        End If
        If Range("z5") Then
            Range("I13").Interior.ColorIndex = 7
            intFind(0) = .Match(Range("J10"), Range("H14:N14"), 0)
            Cells(14, intFind(0)).Interior.ColorIndex = 7
            intFind(1) = Range("AC16") + 15
            Cells(intFind(1), 1).Interior.ColorIndex = 7
        End If
        Cells(intFind(1), intFind(0)).Interior.ColorIndex = 7
    End With
End Sub


P.S.: nur das mit der Handelsware klappt nicht, weil ich nicht kapiert habe was da passieren soll. Dürfte aber auch nur ne Kleinigkeit sein.
MfG Peter
Anzeige
AW: Schnittmenge markieren
02.06.2006 13:17:18
Frank
Hallo Peter,
erst einmal vielen Dank. Funktioniert super und Du hast mir damit wirklich sehr geholfen. Kannst Du mir evtl. auch noch sagen, wie ich es hinbekomme, dass der Wert der in der Zelle der markierten Schnittmenge steht zum Beispiel in der Zelle b10 angezeigt wird.
Warum hast Du geschrieben "ich glaub jetzt hab ichs kapiert " Was kapiert ?
Herzliche Grüße und nochmals tausend Dank
Frank Zimmermann
AW: Schnittmenge markieren
02.06.2006 13:36:16
Peter
Servus,
was kapiert wie das mit der Handelsware zu funktionieren hat.
tausch die letzten 3 Zeilen im Code aus
        Range("B10") = Format(Cells(intFind(1), intFind(0)), "0.00 €")
End With
End Sub

MfG Peter
Anzeige
AW: Schnittmenge markieren
02.06.2006 14:19:32
fcs
Hallo Frank,
habe deinen Code auch etwas bereinigt, wobei einige Lösungen von Peter noch eleganter sind. 

Sub Zellabfrage()
Dim Umsack As Range, Umkarton As Range, Handelsware As Range, Bereich As Range
Dim Umverpackung As String, Verpackung As String, Gewicht As Double, Farbe As XlColorIndex
Dim i As Integer, j As Integer
' Festlegen der 3 Bereich, die ggf. markiert werden sollen
Set Umsack = Range("A13:G27")
Set Umkarton = Range("A29:G43")
Set Handelsware = Range("H13:N27")
Farbe = 7 ' Colorindex der Farbe der markierung
Select Case Range("aa7").Value
Case 1: Range("d10").Value = "Umsack"
Case 2: Range("d10").Value = "Umkarton"
Case 3: Range("d10").Value = "Düsseldorfer Karton"
Case 4: Range("d10").Value = "Pfandkiste"
End Select
Umverpackung = Range("d10").Value
Select Case Range("ab7")
Case 1: Range("j10").Value = "Netz/RS"
Case 2: Range("j10").Value = "CarryFresh"
Case 3: Range("j10").Value = "Folie"
End Select
Verpackung = Range("j10").Value
Select Case Range("ac16")
Case 1: Range("i10").Value = 0.5
Case 2: Range("i10").Value = 0.75
Case 3: Range("i10").Value = 1
Case 4: Range("i10").Value = 1.5
Case 5: Range("i10").Value = 2
Case 6: Range("i10").Value = 2.5
Case 7: Range("i10").Value = 3
Case 8: Range("i10").Value = 4
Case 9: Range("i10").Value = 5
Case 10: Range("i10").Value = 10
Case 11: Range("i10").Value = 12.5
Case 12: Range("i10").Value = 25
End Select
Gewicht = Range("i10").Value
' Hintergrundfarbe der Bereiche zurücksetzen
Umsack.Interior.ColorIndex = xlNone
Umkarton.Interior.ColorIndex = xlNone
Handelsware.Interior.ColorIndex = xlNone
If Range("z5") = True Then
Set Bereich = Handelsware
GoTo Markieren
Else
Select Case Range("d10")
Case "Umsack", "Düsseldorfer Karton"
Set Bereich = Umsack
GoTo Markieren
Case "Umkarton", "Pfandkiste"
Set Bereich = Umkarton
GoTo Markieren
End Select
End If
Exit Sub
'Zellen im Bereich markieren
Markieren:
'Umverpackung markieren (Zeile 1 des Bereichs durchsuchen)
For i = 1 To Bereich.Columns.Count
If Bereich(1, i) = Umverpackung Then
Bereich(1, i).Interior.ColorIndex = Farbe
End If
Next
'Verpackung markieren (Zeile 2 des Bereichs durchsuchen)
For i = 1 To Bereich.Columns.Count
If Bereich(2, i) = Verpackung Then
Bereich(2, i).Interior.ColorIndex = Farbe
'Gewicht markieren (Spalte 1 des Bereichs durchsuchen)
For j = 4 To Bereich.Rows.Count
If Bereich(j, 1) = Gewicht Then
Bereich(j, 1).Interior.ColorIndex = Farbe
'Schnittzelle markieren
Bereich(j, i).Interior.ColorIndex = Farbe
Range("B10").Value = Bereich(j, i).Value
Exit For
End If
Next j
Exit For
End If
Next i
End Sub


Gruß
Franz
Anzeige
AW: Schnittmenge markieren
02.06.2006 17:54:51
Frank
Auch Dir Vielen Dank,
davon abgesehen, dass es jetzt funktioniert, habe ich von beiden Hilfen (beiden Codes) sehr viel lernen können
Danke und Gruß
Frank

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige