Wenn funtion/bedingte Formatierung?

[Maximus]

Hallo,
bei meiner Excel Datei werden durch ein VBA-Programm Werte von einem Tabellenblatt ins nächste übernommen.

In einer bestiimte Zelle(G33) möchte ich jedoch folgendes hinbekommen:

- wenn Wert positiv (Plusbeträge), soll anstatt der Plusbetrag der Betrag 0€ dort stehen!


Ist das über eine Zellenprogrammierung möglich?
Wie müßte so eine Formel aussehen?

Gruss Markus

[RPP63]

Moin!
Ginge über ein benutzerdefiniertes Zahlenformat:

	C
1	0 €

Zelle	Format	Wert
C1	"0" €;[Rot]-#.##0,00 €	123,454

Allerdings steht dann dennoch der positive Wert in der Zelle, wird jedoch nicht angezeigt.
Wenn tatsächlich 0 drin stehen soll, dann =MIN(0;DeineFormel)

Gruß Ralf

[Kuwer]

Hallo Markus,

wenn das per VBA übernommen wird, kann man das ja mit einbauen:

  With Worksheets("Tabelle1") 'entsprechend anpassen
   With .Range("G33")
     If .Value > 0 Then .Value = 0
   End With
 End With

Gruß Uwe

[Maximus]

Hi Ralf,
was meinst du mit "deine Formel"?

=MIN(0;Deine Formel)

Eine Idee die mir beim Ausprobieren gekommen ist, sich einfach den positiven Wert durchstreichen lassen.
Durch:
-bedingte Formatierung, Neue Regel, nur Zelle formatieren,Zellwert kleiner als Null, Durchstreifen

[Maximus]

Danke Kuver, werde ich ausprobieren, weiss nicht ob ich diese Formel mit eingebaut bekomme, weil ich das VBA Programm nicht selber geschrieben habe und somit nicht weiss wo genau dieses Teilstück mit hin muss.

[Maximus]

Hallo, wie kann man folgende VBA Programme verbinden, dass automatisch beide Programme abgespielt werden:

Programm 1:

Code:

Sub Kopie()
    Dim wks As Worksheet
On Error Resume Next
'ActiveSheet.Copy after:=Worksheets(Worksheets.Count)

   ActiveSheet.Copy after:=Worksheets(Worksheets.Count)
   Sheets(Sheets.Count).Name = "Kopie" & Sheets.Count - 2
   With Worksheets("Kopie" & Sheets.Count - 3)
    .Range("F45").Copy
     Range("A45").PasteSpecial Paste:=xlPasteValues
    .Range("E28").Copy
     Range("B28").PasteSpecial Paste:=xlPasteValues
     Range("C8").PasteSpecial Paste:=xlPasteValues
    .Range("G38").Copy
     Range("G33").PasteSpecial Paste:=xlPasteValues
   
   
   ActiveSheet.Buttons.Add(868.5, 232.5, 76.5, 34.5).Select
    Selection.OnAction = "kopieren"
    Selection.Characters.Text = "nach Spielabschnitt kopieren"
    ActiveSheet.Shapes("Button 1").ScaleHeight 1.7156877175, msoFalse, _
        msoScaleFromTopLeft
    ActiveSheet.Shapes("Button 1").ScaleHeight 1.0114284583, msoFalse, _
        msoScaleFromTopLeft
        
    Range("M21").Select
    Range("L1").Select
    
   Application.CutCopyMode = False
   
End With
End Sub


Programm 2:

With Worksheets("Tabelle1") 'entsprechend anpassen
   With .Range("G33")
     If .Value > 0 Then .Value = 0
   End With
 End With

Anstatt Tabelle 1 soll stehen: Kopie1,Kopie2,Kopie3......und das fortlaufend......
Notwendig, weil durch das Programm1 fortlaufend Kopien erstellt werden.

Hat einer eine Idee?

Gruss Markus

[Kuwer]

Hallo Markus,

vielleicht so:

Sub Kopie()
 On Error Resume Next
 'ActiveSheet.Copy after:=Worksheets(Worksheets.Count)

 ActiveSheet.Copy after:=Worksheets(Worksheets.Count)
 Sheets(Sheets.Count).Name = "Kopie" & Sheets.Count - 2
 With Worksheets("Kopie" & Sheets.Count - 3)
    Range("A45").Value = .Range("F45").Value
    Range("B28").Value = .Range("E28").Value
    Range("C8").Value = .Range("E28").Value
    If .Range("G38").Value > 0 Then
      Range("G33").Value = 0
    Else
      Range("G33").Value = .Range("G38").Value
    End If
 End With
 With ActiveSheet.Buttons.Add(868.5, 232.5, 76.5, 34.89428181135)
   .OnAction = "kopieren"
   .Characters.Text = "nach Spielabschnitt kopieren"
 End With
 Application.CutCopyMode = False
End Sub

Gruß Uwe

[Maximus]

Danke Kuwer für deine Mühe,
zeigt dann leider eine Fehlermeldung an.
Ich probiere noch so ein bissel rum.
Danke nocmals fürs Programm!

Gruss u. schönen Abend noch!

[Kuwer]

Hallo Markus,

zeigt dann leider eine Fehlermeldung an.

bei mir läuft dieses Makro durch, selbst bei deaktiviertem On Error Resume Next.

Gruß Uwe

[Maximus]

hi,
kollidiert wohl mit einem zweiten Makro, weches sich auch in der Datei befindet.
Ich werde dieses Problem jetzt einer bedingten Formatierung lösen. Danke nochmal!