Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

Per anwählen (select) einer Zelle weitere Funtionen starten





Frage

Ich würde gerne beim auswählen einer Zelle dort sofort eine Markierung ( x ) setzen und noch die Farbe der Zelle auswählen können. Anschliessend soll dann geschaut werden wechle Spalten mit einem ´ x ´ versehen sind und diese auswählen. Da ich mich erst ein paar Tage mit Makros befasst habe komme ich hier nicht weiter. Ich hoffe es kann mir jemand helfen. Danke schon mal, Gruß Dungemond

Antwort 1 von fürLau

Hallo, Dungemond

Der erste Teil Deiner Frage ist relativ leicht zu realiseren:
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Target.Value = "x"
Target.Interior.ColorIndex = 4
End Sub

Um zur Beantwortung des zweiten Teils
Zitat:
Anschliessend soll dann geschaut werden wechle Spalten mit einem ´ x ´ versehen sind und diese auswählen.
etwas Sinnvolles beitragen zu können, sollte bekannt sein, ob "x" nur in einer bestimmten Zeile gesucht werden soll, oder in der ganzen Spalte.

Gruß[h3]{[h1]Ó¤[sup...fürLau
Signatur wurde ganz und gar ohne SNTool erstellt.

Antwort 2 von Dungemond

Hallo Lau!

Danke schon mal für die Antwort.

Mit dem ´ x ´ soll dann ein bestimmter Bereich markiert werden. Also halt in der Spalte dann einige Werte. Z.B. das x dann in A1 und es sollen dann A2:A100 markiert werden und dann wieder in E1 ein x und entsprechend zu der anderen Markierung noch E2:E100 markiert werden.

Gruß Dungemond

Antwort 3 von fürLau

Hallo

Hoffe es gefällt Dir so:;-)

Option Explicit
Option Base 1
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim xspalten() As String, xzellen%, zaehler, farbe, rngStr$
Target.Value = "x"
farbe = InputBox("ColorIndex-Farbe für Zelle " & Target.Address & _
" wählen...", "Welche Farbe?", Default:=4)
If farbe = "" Then Exit Sub
Target.Interior.ColorIndex = farbe
ReDim xspalten(1)
For xzellen = 1 To 256
If ActiveSheet.Cells(1, xzellen) = "x" Then
zaehler = zaehler + 1
ReDim Preserve xspalten(zaehler)
Rem zeilen 2 bis 100 merken
xspalten(zaehler) = Range(Cells(2, xzellen), Cells(100, xzellen)).Address
End If
Next xzellen
For xzellen = 1 To UBound(xspalten)
rngStr = rngStr & xspalten(xzellen) & ","
Next
Range(Left(rngStr, Len(rngStr) - 1)).Select
Cancel = True ´rem Kein Kontextmenü
End Sub


Damit beim entfernen des "x" die Zellfarbe zurückgesetzt wird zusätzlich das:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = 1 And Target.Interior.ColorIndex <> xlColorindexDefault Then
Target.Interior.ColorIndex = xlColorindexDefault
End If
End Sub


Gruß[h3]{[h1]Ó¤[sup...fürLau
Signatur wurde ganz und gar ohne SNTool erstellt.

Antwort 4 von Dungemond

Hey,
vielen dank, ist echt sehr cool!
Muss sie noch ein wenig anpassen für meine Verwendung, aber das sieht schon sehr gut aus ;)

Gruß Dungemond

Antwort 5 von Dungemond

So weit funktioniert alles super, habe grad nur noch ein kleines Problem. Weiss auch net bin ich grad zu blöd!?
Wie kann ich nun von den ausgewehlten Markierungen ein Diagramm erstellen lassen. Also das Diagramm ist schon formatiert und so, es fehlen lediglich noch die Werte.

Hoffe du kannst mir nochmal helfen, wäre klasse ;)

Antwort 6 von fürLau

Hallo

Benutze folgende Anregung:;-)

Dim ch As Range
Set ch = ActiveSheet.ChartObjects(1).Chart
ch.SetSourceData Source:=Left(rngStr, Len(rngStr) - 1)
Set ch = Nothing


Gruß[h3]{[h1]Ó¤[sup...fürLau
Signatur wurde ganz und gar ohne SNTool erstellt.

Antwort 7 von Dungemond

Hey,

danke nochmal für deine Hilfe.
Er hatte beim ausführen einen Fehler gebracht, aber dadurch hatte ich festgestellt, das es auch viel leichter geht :)
Ich sage ihm nun einfach nur welches Sheet er nehmen soll und damit nimmt er automatisch die ausgewählten Bereiche.

Gruß Dungemond

Antwort 8 von Dungemond

Hallo fürLau

Hast du mir vielleicht noch eine Idee für das Problem von mir ?
https://supportnet.de/threads/1351992

Danke schonmal

Antwort 9 von fürLau

Bittesehr:
https://supportnet.de/threads/1351992

Gruß[h3]{[h1]Ó¤[sup...fürLau
Signatur wurde ganz und gar ohne SNTool erstellt.

Antwort 10 von fürLau

Hallo Dungemond,

Hab´ noch ein wenig dranrumgebastel, das kam dabei rum:
in ein Modul:
Option Explicit

Sub Diagramm_Farben_aus_Zellen_Farben()
Dim ch As Chart
Dim chs As Series
Dim sba As String, p%, co%
Rem Erstes Diagramm wählen (1)
Set ch = ActiveSheet.ChartObjects(1).Chart
Rem Erste Datenreihe wählen
Set chs = ch.SeriesCollection(1)
Debug.Print ch.Name, ch.SeriesCollection.Count
Rem Für jede DatenSpalte
For Each chs In ch.SeriesCollection
Rem Datenquelle(n) auslesen
Debug.Print chs.Points.Parent.Formula
sba = chs.Points.Parent.Formula
p = InStr(1, sba, "!")
Rem Zellen-Bereichs-Adresse feststellen
Debug.Print Mid(sba, 1 + p, Len(sba) - (p + 3))
Rem Zellen Farbe auslesen
co = ActiveSheet.Range(Mid(sba, 1 + p, Len(sba) - (p + 3))).Interior.ColorIndex
Rem Farbe zuweisen
chs.Interior.ColorIndex = co
Next
Set chs = Nothing
Set ch = Nothing
End Sub


und in den Code-Bereich des Tabellenblattes mit dem Diagramm:


Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim xspalten() As String, xzellen%, zaehler, farbe, rngStr$
Dim ch As Chart
If Target.Row <> 1 Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
Cancel = True
Rem Kein Kontextmenü
Target.Value = "x"
ActiveSheet.Range((Cells(Target.Row, Target.Column).Address), _
Range(Cells(65536, Target.Column).Address).End(xlUp)).Select
farbe = Application.Dialogs.Item(84).Show
 If farbe = "" Then Exit Sub
ReDim xspalten(1)
For xzellen = 1 To 256
If ActiveSheet.Cells(1, xzellen) = "x" Then
zaehler = zaehler + 1
ReDim Preserve xspalten(zaehler)
Rem zeilen 2 bis letzte belegte merken
Rem xspalten(zaehler) = Range(Cells(2, xzellen), Cells(6, xzellen)).Address
xspalten(zaehler) = ActiveSheet.Range((Cells(2, xzellen).Address), _
Range(Cells(65536, xzellen).Address).End(xlUp)).Address
End If
Next xzellen
For xzellen = 1 To UBound(xspalten)
rngStr = rngStr & xspalten(xzellen) & ","
Next
Range(Left(rngStr, Len(rngStr) - 1)).Select
Set ch = ActiveSheet.ChartObjects(1).Chart
ch.SetSourceData Source:=Range(Left(rngStr, Len(rngStr) - 1))
Set ch = Nothing
Call Diagramm_Farben_aus_Zellen_Farben
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = 1 And Target.Interior.ColorIndex <> xlColorIndexNone Then
ActiveSheet.Range((Cells(Target.Row, Target.Column).Address), _
Range(Cells(65536, Target.Column).Address).End(xlUp)).Interior.ColorIndex = xlColorIndexNone
End If
End Sub


Hoffe Du kammst damit klar

Gruß[h3]{[h1]Ó¤[sup...fürLau
Signatur wurde ganz und gar ohne SNTool erstellt.

Antwort 11 von Dungemond

Danke
Hatte ich gestern garnicht gesehen gehabt ;)

Ich bin leider noch nicht ganz durch gestiegen, wie es funktioniert, aber denke das ist mal wieder super.

Hoffe ich bekomme es noch für mein Programm eingearbeitet.

Gruß Dungemond

Antwort 12 von Dungemond

Hi, also ich habe nun doch noch ein Problem festgestellt wenn ich:
farbe = Application.Dialogs.Item(84).Show
mache, dann steht in ´farbe´ nur Wahr. Wenn ich nun dann:
Target.Interior.ColorIndex = farbe
mache, dann steht in Target.Interior.ColorIndex nur ´-4105´.
Ich weiss auch nicht, recht aber denke der übernimmt dir Farbauswahl nicht.

Wenn du eine Idee dazu hast, kannst dir bis Montag Zeit lassen, vorher werde ich nicht weitermachen ;)

Danke schonmal

Antwort 13 von fürLau

Hi,

Der Application.Dialogs(xlDialogPatterns) entsprich(84) liefert nicht den selektierten Colorindex, sondern lediglich, wie der Benutzer den Dialog mit OK =Wahr bzw. Abbrechen =Falsch abgeschloßen hat, zurück.
Die getroffene Auswahl bezieht sich auf den vor dem Aufruf aktiven Zellbereich. In Deinem Fall sollte also ein Konstrukt:

Target.select
farbe = Application.Dialogs(xlDialogPatterns).Show
If farbe = False then
Rem Benutzer hat abgebrochen
Debug.print Target.Interior.ColorIndex
Else
farbe = Target.Interior.ColorIndex
End If

einsetzbar sein.

Gruß[h3]{[h1]Ó¤[sup...fürLau
Signatur wurde ganz und gar ohne SNTool erstellt.

Antwort 14 von Dungemond

Hey!

Danke mal wieder, hast mir wieder mal sehr geholfen.
Hatte bei mir auch noch einen kleinen Fehler, den ich nun aber beheben konnte.

Gruß Dungemond

Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: