Nutzung der Aktiven Zelle

Function isPigmV(c As Range) As Boolean 'prüft ob die Zelle im Zellbereich "PigmV" enthalten ist For Each r In Tabelle1.Range("PigmV") If c.Address = r.Address Then isPigmV = True ' MsgBox c.Address Else isPigmV = False End If Next r End Function

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

…Günter,
du musst sie nur in einer ZellFml oder einer Subprozedur (Makro) einsetzen! Allerdings sollte die udFkt für diesen speziellen Zweck noch etwas erweitert wdn…

Rem Fkt prüft, ob Arg2 in Arg1 enthalten ist und gibt  bei
'   Arg3=fehlt/0[FALSCH] Arg2/Nothing bzw =1[WAHR] Wahr/Falsch zurück
Function IsCellOf(Bereich As Range, Optional Bezug As Range, Optional ByVal NurEx As Boolean)
If Bezug Is Nothing Then Set Bezug = ActiveCell
IsCellOf = Intersect(Bezug, Bereich)
If NurEx Then IsCellOf = Not IsCellOf Is Nothing
End Function

Habe die udFkt gleich auf das unbedingt Notwendige zurechtgestutzt und außerdem verallgemeinert, so dass du diese Prüfung auch mit jedem anderen Zellbereich und jeder beliebigen Zelle von jeder beliebigen FmlStandortZelle aus durchführen kannst.
In ZellFml → C48:=WENN(IsCellOf(PigmV;;1);IsCellOf(PigmV)-vglwertzelle;"") Unter der Voraussetzung, dass das Ergebnis der 1.vglwertzelle in C48 angegeben wdn soll und der Bereichsname von C11 bis L23 PigmV ist.
Das ist im Prinzip nur ein Anwendungsbsp, da ich hierzu nicht mehr sagen kann, weil du die Beziehungen der betroffenen Zellen nicht vollständig dargestellt hast (welche Zellen wdn aktiviert, nach welchem Modus sollen die Zellen von C48 bis M48 gefüllt wdn → nach1ander bis alle Werte enthalten, können sie auch mehrfach neu berechnet/gefüllt wdn, wie ist sonst die Beziehung zu PigmV, enthalten sie evtl schon Werte und können/sollen deshalb keine Fml aufnehmen…). Wenn dir das schwerfällt, solltest du eine BspDatei hier hochladen.
Wenn du das Ganze lieber ohne ZellFmln durchführen willst/musst, kannst du die udFkt auch aus einer Subroutine heraus aufrufen. Allerdings musst du in der dann noch alles pgmieren, was die Bereitstellung der FktsArgumente und das Schreiben des FktsErgebnisses in die richtige Zelle betrifft.
Gruß Luc :-?

…bestimmt nicht so gemacht wie du es haben willst, Günter,
und auch für mich geht das Ratespiel weiter, das ich inzwischen leid bin. Aus deinen Angaben ergeben sich deine Ergebnisse nicht! Versuche es doch mal mit einer einfachen manuellen Umsetzung, so, wie jeder mal anfängt. Du scheinst wirklich so wenig Ahnung von Kalkulationspgmm (nicht nur von VBA u. Xl!) zu haben, dass es dir nicht möglich zu sein scheint, exakt zu beschreiben bzw mit einfachen Formeln vorzuzeigen, was gemacht wdn soll. Da muss bestimmt noch mehr gerechnet wdn, über die von dir jetzt angegebene Hilfsformel hinaus!
Dein Auftakt mit irgendwoher besorgter udFkt hat irgendwie verwischt, dass du im Grunde genommen völlig ahnungslos bist (was du ja auch beim Level angegeben hast).
Falls sich aber deine Hilfsformel erfolgreich auf Sepps Ergebnis bezieht, dann hat nicht gestimmt, was du mir geschrieben hast, u/o die Formatierung von PigmV stimmt nicht, u/o stand das etwa in der udFkt (fiel mir nicht auf!), u/o…?
Wenn du hierauf klickst, kannst du meinen letzten Stand herunterladen, aber der entspricht nicht deinen Werten, nur die Sache mit dem Pluszeichen ist jetzt in der (benutzerdefinierten) Formatierung.
Gruß Luc :-?
PS: Durch Vgl der 2-3 PgmVersionen kommst du evtl darauf, wie die Berechnung richtig sein muss…

Private Sub Worksheet_SelectionChange(ByVal Target As Range) Const QBerAdr As String = "PigmV", ZBerAdr As String = "C48:M48" Dim VglZ As Range, QBer As Range, VBer As Range, ZBer As Range Set QBer = Me.Range(QBerAdr): Set ZBer = Me.Range(ZBerAdr) If Target.Cells.Count = 1 And Not Intersect(Target, QBer) Is Nothing Then Set VBer = WorksheetFunction.Index(QBer, Target.Row - 10, 0) For Each VglZ In VBer If Target 0 Then ZBer(VglZ.Column - 2).Value = VglZ / Target - 1 Else: ZBer(VglZ.Column - 2).Value = VglZ - 1 End If Next VglZ Else: ZBer = Empty End If Set QBer = Nothing: Set VBer = Nothing: Set ZBer = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

24 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

24
Beiträge zum Forumthread

Beiträge zu diesem Forumthread