Summe 100%

[uwedj]

Hallo Experten .......

könnt ihr mir bitte bei folgendem problem helfen :

habe 5 eingabefelder nebeneinander die in der summe immer 100% ergeben
müssen , nicht mehr und nicht
weniger um daran gekoppelte mengen anteilig zu ermitteln ......

also
A1= 50%
B1= 25%
C1= 0%
D1= 5%
E1= 15%

werden werte eingegeben die kein 100% ergeben in irgendeinem feld,dann
sollte eine box aufgehen und warnen......

geht das ???

vielen dank

gruss
uwe schröder

[Melanie Breden]

Hallo uwe,

Post by uwedj
habe 5 eingabefelder nebeneinander die in der summe immer 100% ergeben
müssen , nicht mehr und nicht
weniger um daran gekoppelte mengen anteilig zu ermitteln ......
also
A1= 50%
B1= 25%
C1= 0%
D1= 5%
E1= 15%
werden werte eingegeben die kein 100% ergeben in irgendeinem feld,dann
sollte eine box aufgehen und warnen......

markiere die Zellen A1:E1 und wähle den Menüpunkt Daten/Gültigkeit.
Wähle im Register 'Einstellungen' unter 'Zulassen' "Benutzerdefiniert"
und trage folgende Formel ein:

=SUMME($A$1:$E$1)=100%


Mit freundlichen Grüssen
Melanie Breden

[uwedj]

Hallo Melanie,

vom grundsatz hast du schon recht ..........nur die zellen sind im ursprung
leer und wenn ich dann die formel bei
gültigkeit benutze kommt " falscher wert " , d.h. schon in die erste leere
zelle dieser 5 muss 100% stehen .....

gibt es eine andere lösung ??

danke

Post by Melanie Breden
Hallo uwe,

Post by uwedj
habe 5 eingabefelder nebeneinander die in der summe immer 100% ergeben
müssen , nicht mehr und nicht
weniger um daran gekoppelte mengen anteilig zu ermitteln ......
also
A1= 50%
B1= 25%
C1= 0%
D1= 5%
E1= 15%
werden werte eingegeben die kein 100% ergeben in irgendeinem feld,dann
sollte eine box aufgehen und warnen......

markiere die Zellen A1:E1 und wähle den Menüpunkt Daten/Gültigkeit.
Wähle im Register 'Einstellungen' unter 'Zulassen' "Benutzerdefiniert"
=SUMME($A$1:$E$1)=100%
Mit freundlichen Grüssen
Melanie Breden
--
- Microsoft MVP für Excel -
Microsoft Excel - Die ExpertenTipps http://tinyurl.com/cmned
Das Excel-VBA Codebook http://excel.codebooks.de
Excel-Auftragsprogrammierung

[Melanie Breden]

Hallo uwe,

Post by uwedj
vom grundsatz hast du schon recht ..........nur die zellen sind im ursprung
leer und wenn ich dann die formel bei
gültigkeit benutze kommt " falscher wert " , d.h. schon in die erste leere
zelle dieser 5 muss 100% stehen .....
gibt es eine andere lösung ??

hmm, entweder erlaubst du auch Werte in der Summe unter 100:

=SUMME($A$1:$E$1)<=100%

oder differenzierst noch mal, indem bei Anzahl eingetragener Werte unter 5
die Summe <100 und danach nur exact 100 sein darf:


=WENN(ANZAHL($A1:$E1)<5;SUMME($A1:$E1)<=100%;SUMME($A1:$E1)=100%)


Mit freundlichen Grüssen
Melanie Breden

[Klaus "Perry" Pago]

Hallo Miteinander,
mittlerweile ist wohl allen klar, dass mittels VBA alles gelöst werden kann.
Die naheliegenden "reinen" Excel-Lösungen werden nicht mehr weiter verfolgt.
Hier eine "einfache" Lösung :):
Die 5 Prozentwerte stehen in A1:E1 - die Summe in F1

Formel in F1: {=SUMME(UND(A1:E1<>"")*A1:E1)} als Matrixformel eingeben

als bedingte Formatierung für F1

=UND(NICHT(F1=100);NICHT(F1=0)) mit einem schicken Farbformat :)

Gruß
Klaus

Post by Melanie Breden
Hallo uwe,

Post by uwedj
vom grundsatz hast du schon recht ..........nur die zellen sind im ursprung
leer und wenn ich dann die formel bei
gültigkeit benutze kommt " falscher wert " , d.h. schon in die erste leere
zelle dieser 5 muss 100% stehen .....
gibt es eine andere lösung ??

=SUMME($A$1:$E$1)<=100%
oder differenzierst noch mal, indem bei Anzahl eingetragener Werte unter 5
=WENN(ANZAHL($A1:$E1)<5;SUMME($A1:$E1)<=100%;SUMME($A1:$E1)=100%)
Mit freundlichen Grüssen
Melanie Breden
--
- Microsoft MVP für Excel -
Microsoft Excel - Die ExpertenTipps http://tinyurl.com/cmned
Das Excel-VBA Codebook http://excel.codebooks.de
Excel-Auftragsprogrammierung

[Melanie Breden]

Hallo Klaus, Hallo Uwe

Post by Klaus "Perry" Pago
mittlerweile ist wohl allen klar, dass mittels VBA alles gelöst werden kann.
Die naheliegenden "reinen" Excel-Lösungen werden nicht mehr weiter verfolgt.

Das sehe ich in diesem thread genauso.

Mein Vorschlag für die Gültigkeitsprüfung in A1:E1 funktioniert in meiner

Post by Klaus "Perry" Pago

Post by Melanie Breden
oder differenzierst noch mal, indem bei Anzahl eingetragener Werte unter 5
=WENN(ANZAHL($A1:$E1)<5;SUMME($A1:$E1)<=100%;SUMME($A1:$E1)=100%)

Leider vermisse ich hierzu eine Rückmeldung vom OP, der stattdessen eine
VBA-Lösung verfolgt, die mit Sicherheit auch funktionieren wird.

Dennoch würde mich interessieren, warum Uwe eine Formellösung
nicht weiter verfolgt.


Mit freundlichen Grüssen
Melanie Breden

[uwedj]

habe die formellösung von wolfgang übernommen

=WENN(SUMME(A1:E1)<100%;"Unter 100%";WENN(SUMME(A1:E1)>100%;"Über
100%";"Genau
100%"))

und ergänzt um seinen box code übernommen ........

schau mir noch klaus lösung als matrixformel ein ....

vielen dank

gruss
uwe

Post by Melanie Breden
Hallo Klaus, Hallo Uwe

Post by Klaus "Perry" Pago
mittlerweile ist wohl allen klar, dass mittels VBA alles gelöst werden kann.
Die naheliegenden "reinen" Excel-Lösungen werden nicht mehr weiter verfolgt.

Das sehe ich in diesem thread genauso.
Mein Vorschlag für die Gültigkeitsprüfung in A1:E1 funktioniert in meiner

Post by Klaus "Perry" Pago

Post by Melanie Breden
oder differenzierst noch mal, indem bei Anzahl eingetragener Werte unter 5
=WENN(ANZAHL($A1:$E1)<5;SUMME($A1:$E1)<=100%;SUMME($A1:$E1)=100%)

Leider vermisse ich hierzu eine Rückmeldung vom OP, der stattdessen eine
VBA-Lösung verfolgt, die mit Sicherheit auch funktionieren wird.
Dennoch würde mich interessieren, warum Uwe eine Formellösung
nicht weiter verfolgt.
Mit freundlichen Grüssen
Melanie Breden
--
- Microsoft MVP für Excel -
Microsoft Excel - Die ExpertenTipps http://tinyurl.com/cmned
Das Excel-VBA Codebook http://excel.codebooks.de
Excel-Auftragsprogrammierung

[uwedj]

klappt auch prima..........

habe nur die formatierung dann auf gleich 100% gesetzt und dann das
ursprüngliche format anzeigen lassen .........
zelle erscheint ansonsten rot mit weißem text

danke nochmal ..........alarmmeldung ist erreicht und funzt

gruss
uwe

Post by Klaus "Perry" Pago
Hallo Miteinander,
mittlerweile ist wohl allen klar, dass mittels VBA alles gelöst werden kann.
Die naheliegenden "reinen" Excel-Lösungen werden nicht mehr weiter verfolgt.
Die 5 Prozentwerte stehen in A1:E1 - die Summe in F1
Formel in F1: {=SUMME(UND(A1:E1<>"")*A1:E1)} als Matrixformel eingeben
als bedingte Formatierung für F1
=UND(NICHT(F1=100);NICHT(F1=0)) mit einem schicken Farbformat :)
Gruß
Klaus

Post by Melanie Breden
Hallo uwe,

Post by uwedj
vom grundsatz hast du schon recht ..........nur die zellen sind im ursprung
leer und wenn ich dann die formel bei
gültigkeit benutze kommt " falscher wert " , d.h. schon in die erste leere
zelle dieser 5 muss 100% stehen .....
gibt es eine andere lösung ??

=SUMME($A$1:$E$1)<=100%
oder differenzierst noch mal, indem bei Anzahl eingetragener Werte unter 5
=WENN(ANZAHL($A1:$E1)<5;SUMME($A1:$E1)<=100%;SUMME($A1:$E1)=100%)
Mit freundlichen Grüssen
Melanie Breden
--
- Microsoft MVP für Excel -
Microsoft Excel - Die ExpertenTipps http://tinyurl.com/cmned
Das Excel-VBA Codebook http://excel.codebooks.de
Excel-Auftragsprogrammierung

[uwedj]

in F1 steht die kontrollsumme der 100%

wenn diese sich also nicht ergibt sollte eine Fehlermeldung kommen !

geht das ?

Post by uwedj
Hallo Experten .......
habe 5 eingabefelder nebeneinander die in der summe immer 100% ergeben
müssen , nicht mehr und nicht
weniger um daran gekoppelte mengen anteilig zu ermitteln ......
also
A1= 50%
B1= 25%
C1= 0%
D1= 5%
E1= 15%
werden werte eingegeben die kein 100% ergeben in irgendeinem feld,dann
sollte eine box aufgehen und warnen......
geht das ???
vielen dank
gruss
uwe schröder

[Wolfgang Habernoll]

Hallo Uwe

A1-E1 sind in % formatiert ? dann geht das

ohne VBA und ohne Box aber Meldung in F1 dann in F1 folgende Formel
=WENN(SUMME(A1:E1)<100%;"Unter 100%";WENN(SUMME(A1:E1)>100%;"Über 100%";"Genau
100%"))

oder mit VBA und Box dies Makro im VBE ins entsprechende Tabellenblatt

Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Range(Target.Address), Range("A1:E1")) Is Nothing
Then Exit Sub
Dim dblSum As Double
dblSum = Application.WorksheetFunction.Sum(Range("A1:E1"))
Select Case dblSum
Case Is > 1
MsgBox ("A C H T U N G Über 100%")
Case Is < 1
MsgBox ("A C H T U N G Unter 100%")
End Select

End Sub

mfG
Wolfgang Habernoll

Post by uwedj
Hallo Experten .......
habe 5 eingabefelder nebeneinander die in der summe immer 100% ergeben
müssen , nicht mehr und nicht
weniger um daran gekoppelte mengen anteilig zu ermitteln ......
also
A1= 50%
B1= 25%
C1= 0%
D1= 5%
E1= 15%
werden werte eingegeben die kein 100% ergeben in irgendeinem feld,dann
sollte eine box aufgehen und warnen......
geht das ???
vielen dank
gruss
uwe schröder

[uwedj]

Hallo Wolfgang

fehler beim kompelieren wird angezeigt ........

will ein go to .......:-))

kannst du nochmal drüber schauen ??
danke

Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Range(Target.Address), Range("i14:m14")) Is Nothing
Then Exit Sub
Dim dblSum As Double
dblSum = Application.WorksheetFunction.Sum(Range("i14:m14"))
Select Case dblSum
Case Is > 1
MsgBox ("A C H T U N G Über 100%")
Case Is < 1
MsgBox ("A C H T U N G Unter 100%")
End Select

End Sub

Post by Wolfgang Habernoll
Hallo Uwe
A1-E1 sind in % formatiert ? dann geht das
ohne VBA und ohne Box aber Meldung in F1 dann in F1 folgende Formel
=WENN(SUMME(A1:E1)<100%;"Unter 100%";WENN(SUMME(A1:E1)>100%;"Über 100%";"Genau
100%"))
oder mit VBA und Box dies Makro im VBE ins entsprechende Tabellenblatt
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Range(Target.Address), Range("A1:E1")) Is Nothing
Then Exit Sub
Dim dblSum As Double
dblSum = Application.WorksheetFunction.Sum(Range("A1:E1"))
Select Case dblSum
Case Is > 1
MsgBox ("A C H T U N G Über 100%")
Case Is < 1
MsgBox ("A C H T U N G Unter 100%")
End Select
End Sub
mfG
Wolfgang Habernoll

Post by uwedj
Hallo Experten .......
habe 5 eingabefelder nebeneinander die in der summe immer 100% ergeben
müssen , nicht mehr und nicht
weniger um daran gekoppelte mengen anteilig zu ermitteln ......
also
A1= 50%
B1= 25%
C1= 0%
D1= 5%
E1= 15%
werden werte eingegeben die kein 100% ergeben in irgendeinem feld,dann
sollte eine box aufgehen und warnen......
geht das ???
vielen dank
gruss
uwe schröder

[Wolfgang Habernoll]

Hallo Uwe

nebenbei es geht noch kürzer, aber beachte den Zeilenubruch den der NR
verursacht, der Code geht bei mir

Private Sub Worksheet_Change(ByVal Target As Range)
'' das ist EINE Zeile
If Application.Intersect(Range(Target.Address), Range("A1:E1")) Is Nothing
Then Exit Sub
''
Select Case Application.WorksheetFunction.Sum(Range("A1:E1"))
Case Is > 1
MsgBox ("A C H T U N G Über 100%")
Case Is < 1
MsgBox ("A C H T U N G Unter 100%")
End Select

End Sub

ich bleib noch nen Moment OL , sag bescheid obs klappt

mfG
Wolfgang Habernoll

Post by uwedj
Hallo Wolfgang
fehler beim kompelieren wird angezeigt ........
will ein go to .......:-))
kannst du nochmal drüber schauen ??
danke
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Range(Target.Address), Range("i14:m14")) Is Nothing
Then Exit Sub
Dim dblSum As Double
dblSum = Application.WorksheetFunction.Sum(Range("i14:m14"))
Select Case dblSum
Case Is > 1
MsgBox ("A C H T U N G Über 100%")
Case Is < 1
MsgBox ("A C H T U N G Unter 100%")
End Select
End Sub

Post by Wolfgang Habernoll
Hallo Uwe
A1-E1 sind in % formatiert ? dann geht das
ohne VBA und ohne Box aber Meldung in F1 dann in F1 folgende Formel
=WENN(SUMME(A1:E1)<100%;"Unter 100%";WENN(SUMME(A1:E1)>100%;"Über

100%";"Genau

Post by Wolfgang Habernoll
100%"))
oder mit VBA und Box dies Makro im VBE ins entsprechende Tabellenblatt
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Range(Target.Address), Range("A1:E1")) Is Nothing
Then Exit Sub
Dim dblSum As Double
dblSum = Application.WorksheetFunction.Sum(Range("A1:E1"))
Select Case dblSum
Case Is > 1
MsgBox ("A C H T U N G Über 100%")
Case Is < 1
MsgBox ("A C H T U N G Unter 100%")
End Select
End Sub
mfG
Wolfgang Habernoll

Post by uwedj
Hallo Experten .......
habe 5 eingabefelder nebeneinander die in der summe immer 100% ergeben
müssen , nicht mehr und nicht
weniger um daran gekoppelte mengen anteilig zu ermitteln ......
also
A1= 50%
B1= 25%
C1= 0%
D1= 5%
E1= 15%
werden werte eingegeben die kein 100% ergeben in irgendeinem feld,dann
sollte eine box aufgehen und warnen......
geht das ???
vielen dank
gruss
uwe schröder

[uwedj]

also die formel ist auch nicht schlecht .........am ende dann aber als " "
anzeige und ansonsten kommt der hinweis ob zu groß oder zu klein ....

versuche den code gleich mal .......

ansonsten bis morgen

danke

gruss
uwe

Post by Wolfgang Habernoll
Hallo Uwe
nebenbei es geht noch kürzer, aber beachte den Zeilenubruch den der NR
verursacht, der Code geht bei mir
Private Sub Worksheet_Change(ByVal Target As Range)
'' das ist EINE Zeile
If Application.Intersect(Range(Target.Address), Range("A1:E1")) Is Nothing
Then Exit Sub
''
Select Case Application.WorksheetFunction.Sum(Range("A1:E1"))
Case Is > 1
MsgBox ("A C H T U N G Über 100%")
Case Is < 1
MsgBox ("A C H T U N G Unter 100%")
End Select
End Sub
ich bleib noch nen Moment OL , sag bescheid obs klappt
mfG
Wolfgang Habernoll

Post by uwedj
Hallo Wolfgang
fehler beim kompelieren wird angezeigt ........
will ein go to .......:-))
kannst du nochmal drüber schauen ??
danke
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Range(Target.Address), Range("i14:m14")) Is Nothing
Then Exit Sub
Dim dblSum As Double
dblSum = Application.WorksheetFunction.Sum(Range("i14:m14"))
Select Case dblSum
Case Is > 1
MsgBox ("A C H T U N G Über 100%")
Case Is < 1
MsgBox ("A C H T U N G Unter 100%")
End Select
End Sub

Post by Wolfgang Habernoll
Hallo Uwe
A1-E1 sind in % formatiert ? dann geht das
ohne VBA und ohne Box aber Meldung in F1 dann in F1 folgende Formel
=WENN(SUMME(A1:E1)<100%;"Unter 100%";WENN(SUMME(A1:E1)>100%;"Über

100%";"Genau

Post by Wolfgang Habernoll
100%"))
oder mit VBA und Box dies Makro im VBE ins entsprechende Tabellenblatt
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Range(Target.Address), Range("A1:E1")) Is Nothing
Then Exit Sub
Dim dblSum As Double
dblSum = Application.WorksheetFunction.Sum(Range("A1:E1"))
Select Case dblSum
Case Is > 1
MsgBox ("A C H T U N G Über 100%")
Case Is < 1
MsgBox ("A C H T U N G Unter 100%")
End Select
End Sub
mfG
Wolfgang Habernoll

Post by uwedj
Hallo Experten .......
habe 5 eingabefelder nebeneinander die in der summe immer 100% ergeben
müssen , nicht mehr und nicht
weniger um daran gekoppelte mengen anteilig zu ermitteln ......
also
A1= 50%
B1= 25%
C1= 0%
D1= 5%
E1= 15%
werden werte eingegeben die kein 100% ergeben in irgendeinem feld,dann
sollte eine box aufgehen und warnen......
geht das ???
vielen dank
gruss
uwe schröder

[uwedj]

genial , läuft auch super ......
der hinweis mit der zeile war der entscheidende :-))

vielen dank

gruss
uwe

Post by Wolfgang Habernoll
Hallo Uwe
nebenbei es geht noch kürzer, aber beachte den Zeilenubruch den der NR
verursacht, der Code geht bei mir
Private Sub Worksheet_Change(ByVal Target As Range)
'' das ist EINE Zeile
If Application.Intersect(Range(Target.Address), Range("A1:E1")) Is Nothing
Then Exit Sub
''
Select Case Application.WorksheetFunction.Sum(Range("A1:E1"))
Case Is > 1
MsgBox ("A C H T U N G Über 100%")
Case Is < 1
MsgBox ("A C H T U N G Unter 100%")
End Select
End Sub
ich bleib noch nen Moment OL , sag bescheid obs klappt
mfG
Wolfgang Habernoll

Post by uwedj
Hallo Wolfgang
fehler beim kompelieren wird angezeigt ........
will ein go to .......:-))
kannst du nochmal drüber schauen ??
danke
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Range(Target.Address), Range("i14:m14")) Is Nothing
Then Exit Sub
Dim dblSum As Double
dblSum = Application.WorksheetFunction.Sum(Range("i14:m14"))
Select Case dblSum
Case Is > 1
MsgBox ("A C H T U N G Über 100%")
Case Is < 1
MsgBox ("A C H T U N G Unter 100%")
End Select
End Sub

Post by Wolfgang Habernoll
Hallo Uwe
A1-E1 sind in % formatiert ? dann geht das
ohne VBA und ohne Box aber Meldung in F1 dann in F1 folgende Formel
=WENN(SUMME(A1:E1)<100%;"Unter 100%";WENN(SUMME(A1:E1)>100%;"Über

100%";"Genau

Post by Wolfgang Habernoll
100%"))
oder mit VBA und Box dies Makro im VBE ins entsprechende Tabellenblatt
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Range(Target.Address), Range("A1:E1")) Is Nothing
Then Exit Sub
Dim dblSum As Double
dblSum = Application.WorksheetFunction.Sum(Range("A1:E1"))
Select Case dblSum
Case Is > 1
MsgBox ("A C H T U N G Über 100%")
Case Is < 1
MsgBox ("A C H T U N G Unter 100%")
End Select
End Sub
mfG
Wolfgang Habernoll

Post by uwedj
Hallo Experten .......
habe 5 eingabefelder nebeneinander die in der summe immer 100% ergeben
müssen , nicht mehr und nicht
weniger um daran gekoppelte mengen anteilig zu ermitteln ......
also
A1= 50%
B1= 25%
C1= 0%
D1= 5%
E1= 15%
werden werte eingegeben die kein 100% ergeben in irgendeinem feld,dann
sollte eine box aufgehen und warnen......
geht das ???
vielen dank
gruss
uwe schröder

[Eike Bimczok]

Hallo Wolfgang,

so eine Lösung ist mir auch vorgeschwebt, du warst nur schneller mit dem
Posten ;-)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'01-2006
'E.Bimczok
Dim myRange As String
myRange = "A1:E1"
If Intersect(Range(myRange), Target) Is Nothing Then
Dim testValue As Double
testValue = Application.WorksheetFunction.Sum(Range(myRange))
testValue = Round(testValue, 1)
If testValue <> 1# Then
dummy = MsgBox("Die Summe " & myRange & _
" muss 100% ergeben!" & vbCr & _
"Momentane Summe: " & _
Format(testValue, "0%"), _
vbCritical)
End If
End If

End Sub

Ich habe lange an dem Problem gehangen, dass es offensichtlich
Rundungsfehler gibt (abhängig von den ausgewählten Werten), so dass zwar
beim Debuggen als Ergebnis der Summe im Lokalfenster "1" angezeigt wird,
aber intern der Wert leicht abweicht (vermutlich in der 10ten
Nachkommastelle oder so). Bei dem Vergleich "If testValue <> 1# Then"
habe ich mich schon ein wenig gewundert, dass ich immer in die Bedingung
reinkomme... Also immer schön runden!

Ich habe übrigens das SelectionChange-Ereignis verwendet. Das hat zwar
von der Perfomance theoretisch Nachteile, da es ja häufiger vorkommt als
das Worksheet_Change-Ereignis. Aber falls man A1 ändert und mit Tab in
B1 springt, dann wird der Wert aufgrund der Intersect-Abfrage nicht
überprüft. Der User könnte dann die Tabelle mit dem fehlerhaften Werten
abspeichern, ohne das der Hinweis kommt. Das kann zwar so auch
passieren, aber die Wahrscheinlichkeit ist deutlich geringer.


Gruß
Eike

p.s. Warum verwendest du Range(Target.Address) anstelle von Target??

Post by Wolfgang Habernoll
Hallo Uwe
A1-E1 sind in % formatiert ? dann geht das
ohne VBA und ohne Box aber Meldung in F1 dann in F1 folgende Formel
=WENN(SUMME(A1:E1)<100%;"Unter 100%";WENN(SUMME(A1:E1)>100%;"Über 100%";"Genau
100%"))
oder mit VBA und Box dies Makro im VBE ins entsprechende Tabellenblatt
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Range(Target.Address), Range("A1:E1")) Is Nothing
Then Exit Sub
Dim dblSum As Double
dblSum = Application.WorksheetFunction.Sum(Range("A1:E1"))
Select Case dblSum
Case Is > 1
MsgBox ("A C H T U N G Über 100%")
Case Is < 1
MsgBox ("A C H T U N G Unter 100%")
End Select
End Sub
mfG
Wolfgang Habernoll

Post by uwedj
Hallo Experten .......
habe 5 eingabefelder nebeneinander die in der summe immer 100% ergeben
müssen , nicht mehr und nicht
weniger um daran gekoppelte mengen anteilig zu ermitteln ......
also
A1= 50%
B1= 25%
C1= 0%
D1= 5%
E1= 15%
werden werte eingegeben die kein 100% ergeben in irgendeinem feld,dann
sollte eine box aufgehen und warnen......
geht das ???
vielen dank
gruss
uwe schröder

[uwedj]

hallo eike,

will mich an den VBA gesprächen nicht beteiligen weil ich es nicht kann :-))

aber bei deinem code kommt die fehlermeldung wann immer du irgendwo auf dem
sheet hinklickst bzw. sie kommt auch wenn du die sheets wechselst auf den
anderen blättern ......
die differenz in der fehlermeldung anzuzeigen die zu den 100 fehlt bzw. sich
darüber ergeben ist natürlich cool .......
gefällt mir .........aber der rest nicht :-))

gruss
uwe

Post by Eike Bimczok
Hallo Wolfgang,
so eine Lösung ist mir auch vorgeschwebt, du warst nur schneller mit dem
Posten ;-)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'01-2006
'E.Bimczok
Dim myRange As String
myRange = "A1:E1"
If Intersect(Range(myRange), Target) Is Nothing Then
Dim testValue As Double
testValue = Application.WorksheetFunction.Sum(Range(myRange))
testValue = Round(testValue, 1)
If testValue <> 1# Then
dummy = MsgBox("Die Summe " & myRange & _
" muss 100% ergeben!" & vbCr & _
"Momentane Summe: " & _
Format(testValue, "0%"), _
vbCritical)
End If
End If
End Sub
Ich habe lange an dem Problem gehangen, dass es offensichtlich
Rundungsfehler gibt (abhängig von den ausgewählten Werten), so dass zwar
beim Debuggen als Ergebnis der Summe im Lokalfenster "1" angezeigt wird,
aber intern der Wert leicht abweicht (vermutlich in der 10ten
Nachkommastelle oder so). Bei dem Vergleich "If testValue <> 1# Then"
habe ich mich schon ein wenig gewundert, dass ich immer in die Bedingung
reinkomme... Also immer schön runden!
Ich habe übrigens das SelectionChange-Ereignis verwendet. Das hat zwar
von der Perfomance theoretisch Nachteile, da es ja häufiger vorkommt als
das Worksheet_Change-Ereignis. Aber falls man A1 ändert und mit Tab in
B1 springt, dann wird der Wert aufgrund der Intersect-Abfrage nicht
überprüft. Der User könnte dann die Tabelle mit dem fehlerhaften Werten
abspeichern, ohne das der Hinweis kommt. Das kann zwar so auch
passieren, aber die Wahrscheinlichkeit ist deutlich geringer.
Gruß
Eike
p.s. Warum verwendest du Range(Target.Address) anstelle von Target??

Post by Wolfgang Habernoll
Hallo Uwe
A1-E1 sind in % formatiert ? dann geht das
ohne VBA und ohne Box aber Meldung in F1 dann in F1 folgende Formel
=WENN(SUMME(A1:E1)<100%;"Unter 100%";WENN(SUMME(A1:E1)>100%;"Über 100%";"Genau
100%"))
oder mit VBA und Box dies Makro im VBE ins entsprechende Tabellenblatt
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Range(Target.Address), Range("A1:E1")) Is Nothing
Then Exit Sub
Dim dblSum As Double
dblSum = Application.WorksheetFunction.Sum(Range("A1:E1"))
Select Case dblSum
Case Is > 1
MsgBox ("A C H T U N G Über 100%")
Case Is < 1
MsgBox ("A C H T U N G Unter 100%")
End Select
End Sub
mfG
Wolfgang Habernoll

Post by uwedj
Hallo Experten .......
habe 5 eingabefelder nebeneinander die in der summe immer 100% ergeben
müssen , nicht mehr und nicht
weniger um daran gekoppelte mengen anteilig zu ermitteln ......
also
A1= 50%
B1= 25%
C1= 0%
D1= 5%
E1= 15%
werden werte eingegeben die kein 100% ergeben in irgendeinem feld,dann
sollte eine box aufgehen und warnen......
geht das ???
vielen dank
gruss
uwe schröder

[Eike Bimczok]

Hallo Uwe,

ich hatte dich so verstanden, dass der Benutzer auf die Fehleinträge
hingewiesen werden soll. Der Hinweis kommt dann bei jedem(!)
SelectionChange-Ereignis, also immer dann, wenn eine andere Zelle
außerhalb A1:E1 selektiert wird. Sobald die Summe der Einträge 100%
ergibt, sollten keine Meldungen mehr erscheinen.
Das mit den vielen Melundungen ist vielleicht etwas penetrant, führt
aber vermutlich auch zu korrekten Einträgen ;-)
Ansonsten verwende doch die bereits vorgeschlagene Formellösung, dann
brauchst du kein VBA und die Meldungen (Message-Box) bleiben komplett weg.

Mir ist aufgefallen, dass du in der Zeile
testValue = Round(testValue, 1) noch die Anzahl der Nachkommastellen
anpassen solltest, beispielsweise auf Round(testValue, 5).

Gruß
Eike

Post by uwedj
hallo eike,
will mich an den VBA gesprächen nicht beteiligen weil ich es nicht kann :-))
aber bei deinem code kommt die fehlermeldung wann immer du irgendwo auf dem
sheet hinklickst bzw. sie kommt auch wenn du die sheets wechselst auf den
anderen blättern ......
die differenz in der fehlermeldung anzuzeigen die zu den 100 fehlt bzw. sich
darüber ergeben ist natürlich cool .......
gefällt mir .........aber der rest nicht :-))
gruss
uwe

Post by Eike Bimczok
Hallo Wolfgang,
so eine Lösung ist mir auch vorgeschwebt, du warst nur schneller mit dem
Posten ;-)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'01-2006
'E.Bimczok
Dim myRange As String
myRange = "A1:E1"
If Intersect(Range(myRange), Target) Is Nothing Then
Dim testValue As Double
testValue = Application.WorksheetFunction.Sum(Range(myRange))
testValue = Round(testValue, 1)
If testValue <> 1# Then
dummy = MsgBox("Die Summe " & myRange & _
" muss 100% ergeben!" & vbCr & _
"Momentane Summe: " & _
Format(testValue, "0%"), _
vbCritical)
End If
End If
End Sub
Ich habe lange an dem Problem gehangen, dass es offensichtlich
Rundungsfehler gibt (abhängig von den ausgewählten Werten), so dass zwar
beim Debuggen als Ergebnis der Summe im Lokalfenster "1" angezeigt wird,
aber intern der Wert leicht abweicht (vermutlich in der 10ten
Nachkommastelle oder so). Bei dem Vergleich "If testValue <> 1# Then"
habe ich mich schon ein wenig gewundert, dass ich immer in die Bedingung
reinkomme... Also immer schön runden!
Ich habe übrigens das SelectionChange-Ereignis verwendet. Das hat zwar
von der Perfomance theoretisch Nachteile, da es ja häufiger vorkommt als
das Worksheet_Change-Ereignis. Aber falls man A1 ändert und mit Tab in
B1 springt, dann wird der Wert aufgrund der Intersect-Abfrage nicht
überprüft. Der User könnte dann die Tabelle mit dem fehlerhaften Werten
abspeichern, ohne das der Hinweis kommt. Das kann zwar so auch
passieren, aber die Wahrscheinlichkeit ist deutlich geringer.
Gruß
Eike
p.s. Warum verwendest du Range(Target.Address) anstelle von Target??

Post by Wolfgang Habernoll
Hallo Uwe
A1-E1 sind in % formatiert ? dann geht das
ohne VBA und ohne Box aber Meldung in F1 dann in F1 folgende Formel
=WENN(SUMME(A1:E1)<100%;"Unter 100%";WENN(SUMME(A1:E1)>100%;"Über

100%";"Genau

Post by Eike Bimczok

Post by Wolfgang Habernoll
100%"))
oder mit VBA und Box dies Makro im VBE ins entsprechende Tabellenblatt
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Range(Target.Address), Range("A1:E1")) Is

Nothing

Post by Eike Bimczok

Post by Wolfgang Habernoll
Then Exit Sub
Dim dblSum As Double
dblSum = Application.WorksheetFunction.Sum(Range("A1:E1"))
Select Case dblSum
Case Is > 1
MsgBox ("A C H T U N G Über 100%")
Case Is < 1
MsgBox ("A C H T U N G Unter 100%")
End Select
End Sub
mfG
Wolfgang Habernoll

Post by uwedj
Hallo Experten .......
habe 5 eingabefelder nebeneinander die in der summe immer 100% ergeben
müssen , nicht mehr und nicht
weniger um daran gekoppelte mengen anteilig zu ermitteln ......
also
A1= 50%
B1= 25%
C1= 0%
D1= 5%
E1= 15%
werden werte eingegeben die kein 100% ergeben in irgendeinem feld,dann
sollte eine box aufgehen und warnen......
geht das ???
vielen dank
gruss
uwe schröder

[Wolfgang Habernoll]

Hallo Eike

"Eike Bimczok" <***@gmx.de> schrieb im Newsbeitrag news:O9AcZP$***@TK2MSFTNGP14.phx.gbl...

Hallo Wolfgang,
p.s. Warum verwendest du Range(Target.Address) anstelle von Target??

Target liefert doch nur Value, ich brauche aber für Intersect-Schnittmenge
zwei Range Bereiche um die Sub sofort zu verlassen wenn das Change-Ereignis
(Target) nicht in A1-E1 ausgelöst wurde.

Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Range(Target.Address), Range("A1:E1")) Is Nothing _
Then Exit Sub

mfG
Wolfgang Habernoll

[Melanie Breden]

Hallo Wolfgang,

Post by Eike Bimczok
p.s. Warum verwendest du Range(Target.Address) anstelle von Target??
Target liefert doch nur Value,

Target liefert deshalb die Value-Eigenschaft, weil dies die Default-Eigenschaft ist
und wenn nichts anderes angegeben wurde, wählt VBA eben die Standardeigenschaft.

Leider führt das dennoch häufig genug zu Mißverständnissen und Fehlern bei
der Ausführung von Code und es ist immer ratsam jedem Objekt die gewünschte
Eigenschaft mitzugeben: "Target.Value"

Post by Eike Bimczok
ich brauche aber für Intersect-Schnittmenge
zwei Range Bereiche um die Sub sofort zu verlassen wenn das Change-Ereignis
(Target) nicht in A1-E1 ausgelöst wurde.
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Range(Target.Address), Range("A1:E1")) Is Nothing _
Then Exit Sub

das stimmt hier so nicht!

Target liefert in der Intersect-Methode tatsächlich ein Range-Objekt.
Es genügt also auch:

If Application.Intersect(Target, Range("A1:E1")) Is Nothing Then Exit Sub


Mit freundlichen Grüssen
Melanie Breden

[Eike Bimczok]

Hallo Melanie,

da bin ich ja beruhigt ;-)

Gruß
Eike

Post by Eike Bimczok
Hallo Wolfgang,

Post by Eike Bimczok
p.s. Warum verwendest du Range(Target.Address) anstelle von Target??
Target liefert doch nur Value,

Target liefert deshalb die Value-Eigenschaft, weil dies die
Default-Eigenschaft ist
und wenn nichts anderes angegeben wurde, wählt VBA eben die
Standardeigenschaft.
Leider führt das dennoch häufig genug zu Mißverständnissen und Fehlern bei
der Ausführung von Code und es ist immer ratsam jedem Objekt die gewünschte
Eigenschaft mitzugeben: "Target.Value"

Post by Eike Bimczok
ich brauche aber für Intersect-Schnittmenge
zwei Range Bereiche um die Sub sofort zu verlassen wenn das
Change-Ereignis
(Target) nicht in A1-E1 ausgelöst wurde.
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Range(Target.Address), Range("A1:E1")) Is Nothing _
Then Exit Sub

das stimmt hier so nicht!
Target liefert in der Intersect-Methode tatsächlich ein Range-Objekt.
If Application.Intersect(Target, Range("A1:E1")) Is Nothing Then Exit Sub
Mit freundlichen Grüssen
Melanie Breden

[Wolfgang Habernoll]

Hallo Melanie

du hast natürlich Recht.

Post by Melanie Breden
Target liefert deshalb die Value-Eigenschaft, weil dies die

Default-Eigenschaft ist

Post by Melanie Breden
und wenn nichts anderes angegeben wurde, wählt VBA eben die

Standardeigenschaft.

Post by Melanie Breden
Leider führt das dennoch häufig genug zu Mißverständnissen und Fehlern bei
der Ausführung von Code und es ist immer ratsam jedem Objekt die gewünschte
Eigenschaft mitzugeben: "Target.Value"

im debug Modus zeigte mir Target eben Value an, da hab ich irgenwann das mal
so
"Range(Target.Address)" gemacht und weil es auch geht nicht wieder drüber
nachgedacht

Post by Melanie Breden

Post by Wolfgang Habernoll
ich brauche aber für Intersect-Schnittmenge
zwei Range Bereiche um die Sub sofort zu verlassen wenn das

Change-Ereignis

Post by Melanie Breden

Post by Wolfgang Habernoll
(Target) nicht in A1-E1 ausgelöst wurde.
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Range(Target.Address), Range("A1:E1")) Is Nothing _
Then Exit Sub

das stimmt hier so nicht!
Target liefert in der Intersect-Methode tatsächlich ein Range-Objekt.

das habe ich in der Tat nicht erkannt, und gelobe Besserung.

Post by Melanie Breden
If Application.Intersect(Target, Range("A1:E1")) Is Nothing Then Exit Sub

Danke für die Aufklärung

mfG
Wolfgang Habernoll

[Melanie Breden]

Hallo Wolfgang,

Post by Wolfgang Habernoll

Post by Melanie Breden
If Application.Intersect(Target, Range("A1:E1")) Is Nothing Then Exit Sub

Danke für die Aufklärung

Bittesehr, dann ist die Excel-Welt ja wieder in Ordnung :-)


Mit freundlichen Grüssen
Melanie Breden

[Eike Bimczok]

Hallo Wolfgang,

jetzt hast du mich noch mehr verwirrt?!
In "Worksheet_Change(ByVal Target As Range)" ist doch Target als Range
deklariert. In der Tat liefert Target als Standardeigenschaft Value
zurück, es handelt sich aber meines Wissens nach um ein vollwertiges
Range-Objekt. Wenn du dir mein Makro ansiehst, verwende ich ja auch
erfolgreich direkt "Target" innerhalb der Intersect-Methode...

Gruß
Eike

Post by Wolfgang Habernoll
Hallo Eike
Hallo Wolfgang,
p.s. Warum verwendest du Range(Target.Address) anstelle von Target??
Target liefert doch nur Value, ich brauche aber für Intersect-Schnittmenge
zwei Range Bereiche um die Sub sofort zu verlassen wenn das Change-Ereignis
(Target) nicht in A1-E1 ausgelöst wurde.
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Range(Target.Address), Range("A1:E1")) Is Nothing _
Then Exit Sub
mfG
Wolfgang Habernoll

[Wolfgang Habernoll]

Hallo Eike

Post by Eike Bimczok
Hallo Wolfgang,
jetzt hast du mich noch mehr verwirrt?!

sorry das tut mir leid habe es jetz begriffen, siehe Antwort bei Melanie

mfG
Wolfgang Habernoll

[Thomas Ramel]

Grüezi Eike und Wolfgang

Eike Bimczok schrieb am 30.12.1899

Post by Eike Bimczok
jetzt hast du mich noch mehr verwirrt?!
In "Worksheet_Change(ByVal Target As Range)" ist doch Target als Range
deklariert.

'Target' in den Ereignis-Prozeduren ist auch gemäss Deklaration immer ein
Range-Objekt.

Post by Eike Bimczok
In der Tat liefert Target als Standardeigenschaft Value
zurück,

Die ist genau dann der Fall, wenn Target aus bloss *einer* Zelle besteht.
Dann kommt die Standard-Eigenschaft .Value zum tragen.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.StatusBar = Target
End Sub

Belegt dies in der Statuszeile, wenn eine oder mehrere (nicht leere) Zellen
selektiert werden wird der Unterschied sichtbar.



Mit freundlichen Grüssen
Thomas Ramel (@work)