Aus 2 Makros eins machen

Christian · 2013-01-22T16:22:23+00:00

Hallo alle zusammen, ich hänge per Text Datei 2 Makros an, wie ihr seht, wird eines davon per Shortcut Strg+y ausgeführt. Könnt ihr mir bitte helfen, aus den beiden Makros eins zu machen, sodass beides durch einmaliges Drücken von Strg+y ausgeführt wird? Danke Christian https://www.herber.de/bbs/user/83511.txt

Hi
das Grundproblem ist, daß du nur ein bestimmtes Format suchen kannst.
du kannst nach rot, blau oder schwarz suchen, aber nicht nach "nicht rot"
diese komplexe suche geht nur mit Texten oder Zahlen.
deswegen vielleicht dieser Workaround:
1. kopiere diese Funktion in ein allgemeines Modul:
die Funktion prüft, ob eine Zelle die schriftfarbe rot hat, mit folgenden Ergebnissen:
Zelle leer: 0
Zelle befüllt, schriftfarbe rot: 2
Zelle befüllt, andere Schriftfarbe: 1

Function IstRot(Zelle As Range) As Long
If Zelle.Value  "" Then
If Zelle.Font.Color = vbRed Then
IstRot = 2
Else
IstRot = 1
End If
Else
IstRot = 0
End If
End Function

2. lege ein zweites Tabellenblatt an.
3. schreibe in dieses Tabellenblatt die Formel: =IstRot(Tabelle1!A1) und kopiere sie soweit, wie du im ersten Tabellenblatt Daten hast.
das geht mit diesem Code:

Sheets("Tabelle2").Range(Sheets("Tabelle1").Usedrange.address).FormulaR1C1 = "=IstRot(Tabelle1!RC)"

wenn du jetzt nach einer nichtroten Zelle suchst, suchst du einfach in Tabelle2 nach 1, wenn du nach einer roten Zelle sucht, suchst du nach 2.
die gefundene Zelladdresse wendest du dann auf erste Tabellenblatt an:

dim rng as Range
set rng = Sheets("Tabelle2").Cells.Find(what:=1, lookat:=xlwhole)
Application.Goto Sheets("Tabelle1").Range(rng.address)

Gruß Daniel

tut mir leid, daß ich nicht hellsehen kann.
kannst ja für jedes Tabellenblatt das gleiche Hilfstabellenblatt verwenden und dann beim Schreiben der Formel den Tabellenblattnamen entsprechend abändern.
Du musst sowieso immer immer mit Makro arbeiten, auch bei der Formel, weil es keinen Sinn macht, die Formeln stehen zu lassen, da Excel bei Formatänderungen die Formeln nicht neu berechnet, daher müssen sie immer wieder neu geschrieben werden.
alternativ geht das selektieren einer nichtroten Zelle auch so:

Sub test()
Dim Bereich1 As Range
Dim Bereich2 As Range
Dim Zelle As Range
Dim StopWert As Long
Dim Zähler As Long
'--- nichtrote Zellen ermitteln
Set Bereich1 = ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants, 3)
For Each Zelle In Bereich1
If Zelle.Font.Color  vbRed Then
If Bereich2 Is Nothing Then
Set Bereich2 = Zelle
Else
Set Bereich2 = Union(Bereich2, Zelle)
End If
End If
Next
'--- aus nichtroten Zellen eine zufällig auswählen
If Bereich2 Is Nothing Then
MsgBox "alles rot"
Else
StopWert = WorksheetFunction.RandBetween(1, Bereich2.Cells.Count)
For Each Zelle In Bereich2
Zähler = Zähler + 1
If Zähler >= StopWert Then Exit For
Next
End If
Zelle.Select
End Sub

Gruß Daniel

Forumthread: Aus 2 Makros eins machen

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Aus 2 Makros eins machen

Forumthread: Aus 2 Makros eins machen

18 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread