PDA

Vollständige Version anzeigen : Variable Verändern


Mephisto666
01.07.2014, 13:36
Hallo Zusammen,

ich bin neu hier, freu mich schon auf interesante unterhaltunegn! :)
Ich habe erst vor kurzem mit VBA angefangen und stehen momentan voll auf dem Schlauch.

Ich möchten den Wert in Zelle A2, welchen ich eingegeben haben 10000 in eine Variable einlesen und in Zelle B2 verändert einfügen.

Die Veränderung soll die letzen 3 Zeichen entfernen.
Das Makro soll ausgelöst werden sobald die Zelle nicht mehr aktiv ist.

Dann will ich in die nächste Zelle A3 und hier soll das Makro wieder zum einsatz kommen usw.....

Vielen dank schon mal allen Hilfreichen Kommentaren!

Grüße
Mephisto666

Hajo_Zi
01.07.2014, 13:40
Warum nicht Formel?
<br/><b><em>Tabelle5</em></b><table border="1" cellspacing="0" cellpadding="0" style="border-color:#000000; border-width: 1px; font-size:11pt; background-color:#ffffff; padding-left:2pt; padding-right:2pt; "><colgroup><col style="font-weight:bold; width:40px;" /><col style="width:126px;" /><col style="width:126px;" /></colgroup><tr style="background-color:#99CCFF; text-align:center; font-weight:bold; "><td>&nbsp;</td><td>AA</td><td>AB</td></tr><tr><td style="background-color:#99CCFF; text-align:center; font-weight:bold; ">5</td><td style="border-color:#000000; color:#000000; border-color:#000000; background-color:#FFFFFF ;; text-align:right; ">100000</td><td style="border-color:#000000; color:#000000; border-color:#000000; background-color:#FFFFFF ;; text-align:right; ">100</td></tr></table><br/><table border="1" cellspacing="0" cellpadding="0" style="border-color:#000000; border-width: 1px;font-size:11pt; background-color:#ffffff; width:800px;padding-left:2pt; padding-right:2pt; "><tr style="background-color:#FFCC66; text-align:center; font-weight:bold; "><td colspan="3" > verwendete Formeln </td><td> </td></tr><tr valign="top" style="background-color:#FFCC66; text-align:center; font-weight:bold; "><td> Zelle </td><td> Formel</td><td> Bereich </td> <td>N/A</td></tr><tr><td>AB5</td><td>=ABRUNDEN(AA5/1000;0)</td><td>&nbsp;</td><td>&nbsp;</td></tr></table><table cellspacing="0" cellpadding="0"><tr style="text-align:left; font-weight:bold; " class="style21"><td style="text-align:left; font-size: xx-small" ><a href="http://excel-inn.de/dateien/vba_beispiele/tabellenanzeige_in_html_addin.zip" >Excel-Inn.de</a></td></tr> <tr style="text-align:left; font-weight:bold; " class="style21"><td style="text-align:left; font-size: xx-small" ><a href='http://Hajo-Excel.de/tools.htm' >Hajo-Excel.de</a></td></tr><tr style="text-align:left; font-weight:bold;" ><td style="text-align:left; font-size: xx-small" >XHTML-Tabelle zur Darstellung in Foren, einschl. der neuen Funktionen ab Version 2007</td></tr><tr style="text-align:left; font-weight:bold; " ><td style="text-align:left; font-size: xx-small" > Add-In-Version 18.04 einschl. 64 Bit</td></tr></table><br/>

<img src="http://Hajo-Excel.de/images/grusz1.gif" align="middle" height="40" alt="Grußformel"><a href="http://Hajo-Excel.de/index.htm"><img border="0" src="http://Hajo-Excel.de/images/logo_hajo3.gif" align="middle" height="40" alt="Homepage"></a>

Mephisto666
01.07.2014, 14:04
Die Excel Datei wird später in ein ein ERP System hochgeladen und dieses mag keine Formeln.
Deshalb möchte ich dies per Makro realisieren. :-)

Grüße und Danke,
Mephisto666

chris-kaiser
01.07.2014, 14:10
Hi,

ich würde auch Formeln nehmen. =links
mit bearbeiten ersetzen sind dann ja die Formeln wieder weg... und

Was soll passieren wenn in B schon etwas steht?
Was ist wenn drei oder weniger Zeichen in A eingetragen werden?
Was soll passieren wenn in A etwas gelöscht wird aber in B schon was steht?
Soll in der Eingabe in A etwas überprüft werden, oder kann da einfach alles stehen?

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
If Target.Column = 1 Then
For Each rng In Intersect(Target, Columns(1))
If rng.Value <> "" And Len(rng.Value) > 2 Then
If rng.Offset(0, 1).Value <> "" Then
If MsgBox("In Zelle B" & rng.Row & " steht etwas soll dieser Wert überschrieben werden", vbYesNo) = vbYes Then
Call changeB(rng)
End If
Else
Call changeB(rng)
End If
End If
Next
End If
End Sub

Sub changeB(rng As Range)
rng.Offset(0, 1).Value = Left(rng.Value, Len(rng.Value) - 3)
End Sub

hier mal was zum herumtesten ;)

aloys78
01.07.2014, 14:24
Hallo,

mein Code-Vorschlag
- im VBA-Projekt unter dem betreffenden Blatt ablegen
- ggf RaBereich anpassen

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim RaBereich As Range
Set RaBereich = Range("A2:A10") 'Eingabebereich <---- ggf anpassen
If Intersect(Target, RaBereich) Is Nothing Then Exit Sub 'Keine Änderung in Sp A
Application.EnableEvents = False
If IsNumeric(Target) And Target > 1000 Then Target.Offset(0, 1) = WorksheetFunction.RoundDown(Target / 1000, 0)
Application.EnableEvents = True
End Sub

Gruß
Aloys

Mephisto666
02.07.2014, 06:11
Hallo,

@Chris-Kaiser,
Danke für die super Hilfe das Makro funktioniert super. Die Idee mit der MsgBox wenn etwas in B steht istz einfach aber genial.
In die Zelle A werden immer 10.000 oder 100.000 Nummer eigetragen.
Wenn in A etwas gelöscht wird soll auch B gelöscht werden.
Spalte A würde ich über die Datenprüffunktion begrenzen das hier nur Zahlen eingetragen werden können.

Grüße und 1000 Dank,
Mephisto666

chris-kaiser
02.07.2014, 08:08
Hi,

das löscht jetzt auch B wenn in A nichts mehr steht

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, check As Boolean
If Target.Column = 1 Then
For Each rng In Intersect(Target, Columns(1))
If rng.Value <> "" And Len(rng.Value) > 2 Then
If rng.Offset(0, 1).Value <> "" Then
If MsgBox("In Zelle B" & rng.Row & " steht etwas soll dieser Wert überschrieben werden", vbYesNo) = vbYes Then
Call changeB(rng)
End If
Else
Call changeB(rng)
End If
Else
rng.Offset(0, 1).Value = ""
End If
Next
End If
End Sub

Sub changeB(rng As Range)
rng.Offset(0, 1).Value = Left(rng.Value, Len(rng.Value) - 3)
End Sub

Mephisto666
07.07.2014, 14:42
Hey Chris,

viel Dank für deine schnelle Unterstützung bei dem Makro!

Grüße
Mephisto666