Zelle überschreiben

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox


Excel-Version: 9.0 (Office 2000)
nach unten

Betrifft: Zelle überschreiben
von: Rolf
Geschrieben am: 08.06.2002 - 08:16:01

Hallo Excel Experten,
in Spalte D1 bis D1000 habe Werte untereinander stehen.
Ich möchte nun, das wenn ein Wert in der Zelle überschrieben wird,
der alte Wert in der Zelle stehen bleibt, ohne Fehlermeldung oder Blattschutz.
Ein wenig ungewöhnlich aber vielleicht geht das ?

Vielen Dank für eure Hilfe!

Tschüß
Rolf


nach oben   nach unten

Re: Zelle überschreiben
von: Hajo
Geschrieben am: 08.06.2002 - 08:23:20

Hallo Rolf

schreibe in VBA in die Tabelle, nicht Modul, nicht DieseArbeitsmappe


Public Wert

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bereich As Range
    Set Bereich = Range("D1:D1000")
    If Not Intersect(Target, Bereich) Is Nothing Then ' Zelle ist im Bereich
        Application.EnableEvents = False
        Target.Value = Wert
        Application.EnableEvents = True
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Bereich As Range
    Set Bereich = Range("D1:D1000")
    If Not Intersect(Target, Bereich) Is Nothing Then ' Zelle ist im Bereich
        Wert = Target.Value
    End If
End Sub

werden die Makros nicht aktiviert nützt Dir der Code nichts.

Gruß Hajo

nach oben   nach unten

Re: Zelle überschreiben
von: Hans W. Hofmann
Geschrieben am: 08.06.2002 - 11:25:03

Hallo ihr beiden,

ich würd bei Worksheet_SelectionChange den Kerl halt gleich wieder aus der Zelle rausbefördern, wenn ein Wert gesetzt ist. Dann brauchts das Zurückschreiben nicht und er merkt, dass er hier nix zu suchen hat...

Gruß HW


nach oben   nach unten

Re: Zelle überschreiben
von: Hans W. Hofmann
Geschrieben am: 08.06.2002 - 11:29:42

Hallo ihr beiden,

ich würd bei Worksheet_SelectionChange den Kerl halt gleich wieder aus der Zelle rausbefördern, wenn ein Wert gesetzt ist. Dann brauchts das Zurückschreiben nicht und er merkt, dass er hier nix zu suchen hat...


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 1 And Target.Value <> 0 Then
Target.Offset(0, 1).Activate
End If
End Sub

Gruß HW



nach oben   nach unten

Re: Zelle überschreiben
von: Rolf
Geschrieben am: 08.06.2002 - 20:49:08

Hallo Hajo,
dein Makro funktioniert super, leider vergaß ich zu sagen, dass die Tabelle schon Makros enthält und ich zu dumm bin es einzufügen.
Kannst du mir noch einmal helfen?

Option Compare Text ' Bei Vergleichen Groß-/Kleinschreibung nicht beachten
Option Explicit

Dim busy As Boolean

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Bereich1 As Range, Bereich2 As Range, Bereich3 As Range
Dim c As Range
Dim col As Integer
Dim AK As String
' ActiveSheet.Unprotect ("laufen")

If busy Then Exit Sub ' zum Verhindern des Selbstaufrufens durch VBA-geänderte Zellen

Set Bereich1 = Range("D2:D1000")
Set Bereich2 = Range("E2:E1000")
Set Bereich3 = Range("I2:I1000")

If Intersect(Target, Bereich1) Is Nothing And Intersect(Target, Bereich2) Is Nothing _
And Intersect(Target, Bereich3) Is Nothing Then Exit Sub

busy = True
Application.ScreenUpdating = False

For Each c In Target

If Not (Intersect(c, Bereich1) Is Nothing) Then

If c.Value = "m" Then
col = 2
ElseIf c.Value = "w" Then
col = 3
Else
c.Select
Application.ScreenUpdating = True
MsgBox "Falscher Wert"
Application.ScreenUpdating = False
col = 0
End If

ElseIf Not (Intersect(c, Bereich2) Is Nothing) Then

If Cells(c.Row, 4) = "m" Then
col = 2
ElseIf Cells(c.Row, 4) = "w" Then
col = 3
Else
col = 0
End If

ElseIf Not (Intersect(c, Bereich3) Is Nothing) Then

If (Len(c) > 6 Or InStr(c, " ") <> 0 Or InStr(c, ".") <> 0) Then
c.Select
Application.ScreenUpdating = True
MsgBox "Unzulässiger Wert"
Application.ScreenUpdating = False
End If
col = -1 ' Verhindern des Beschreibens der "AK"-Spalte

End If

If col > 0 Then
AK = ""
On Error Resume Next
AK = Application.WorksheetFunction.VLookup(Cells(c.Row, 5), _
Worksheets("Klasseneinteilung").Range("B2:D150"), col, False)
On Error GoTo 0
Cells(c.Row, 6) = AK
ElseIf col = 0 Then
Cells(c.Row, 6) = ""
End If

Next c
' ActiveSheet.Protect ("laufen")
Application.ScreenUpdating = True
busy = False

End Sub

' ab hier Makro von Hajo

Public Wert
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range
Set Bereich = Range("F1:F1000")
If Not Intersect(Target, Bereich) Is Nothing Then ' Zelle ist im Bereich
Application.EnableEvents = False
Target.Value = Wert
Application.EnableEvents = True
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Bereich As Range
Set Bereich = Range("F1:F1000")
If Not Intersect(Target, Bereich) Is Nothing Then ' Zelle ist im Bereich
Wert = Target.Value
End If
End Sub

Vielen Dank!

Tschüß
Rolf

nach oben   nach unten

Re: Zelle überschreiben
von: Hajo
Geschrieben am: 08.06.2002 - 21:00:12

Hallo Rolf

ich will mir Dein Makro jetzt nich zu Gemüte ziehen.

Public Wert muß als erste Zeile im Codeteil der Tabelle stehen bzw. hinter Option Explicit

Du hasr schon ein Ereignis Private Sub Worksheet_Change(ByVal Target As Range)
füge meinen Code vor End Sub ein, dann müßte es laufen.

Es ist immer schwierig sich in einen code von jemand anderes einzuarbeiten, wenn dieser ohne Kommentare ist und es kostet doch sehr viel Zeit darum erstmal so.

Gruß Hajo


nach oben   nach unten

Re: Zelle überschreiben
von: Rolf
Geschrieben am: 08.06.2002 - 22:32:18

Hallo Hajo,
Makro habe ich eingebaut, funktioniert aber noch nicht.

Option Compare Text ' Bei Vergleichen Groß-/Kleinschreibung nicht beachten
Option Explicit
Public Wert

Dim busy As Boolean

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Bereich1 As Range, Bereich2 As Range, Bereich3 As Range
Dim c As Range
Dim col As Integer
Dim AK As String
' ActiveSheet.Unprotect ("laufen")

If busy Then Exit Sub ' zum Verhindern des Selbstaufrufens durch VBA-geänderte Zellen

Set Bereich1 = Range("D2:D1000")
Set Bereich2 = Range("E2:E1000")
Set Bereich3 = Range("I2:I1000")

If Intersect(Target, Bereich1) Is Nothing And Intersect(Target, Bereich2) Is Nothing _
And Intersect(Target, Bereich3) Is Nothing Then Exit Sub

busy = True
Application.ScreenUpdating = False

For Each c In Target

If Not (Intersect(c, Bereich1) Is Nothing) Then

If c.Value = "m" Then
col = 2
ElseIf c.Value = "w" Then
col = 3
Else
c.Select
Application.ScreenUpdating = True
MsgBox "Falscher Wert"
Application.ScreenUpdating = False
col = 0
End If

ElseIf Not (Intersect(c, Bereich2) Is Nothing) Then

If Cells(c.Row, 4) = "m" Then
col = 2
ElseIf Cells(c.Row, 4) = "w" Then
col = 3
Else
col = 0
End If

ElseIf Not (Intersect(c, Bereich3) Is Nothing) Then

If (Len(c) > 6 Or InStr(c, " ") <> 0 Or InStr(c, ".") <> 0) Then
c.Select
Application.ScreenUpdating = True
MsgBox "Unzulässiger Wert"
Application.ScreenUpdating = False
End If
col = -1 ' Verhindern des Beschreibens der "AK"-Spalte

End If

If col > 0 Then
AK = ""
On Error Resume Next
AK = Application.WorksheetFunction.VLookup(Cells(c.Row, 5), _
Worksheets("Klasseneinteilung").Range("B2:D150"), col, False)
On Error GoTo 0
Cells(c.Row, 6) = AK
ElseIf col = 0 Then
Cells(c.Row, 6) = ""
End If

Next c
' ActiveSheet.Protect ("laufen")
Application.ScreenUpdating = True
busy = False

Private Sub Worksheet_Change(ByVal Target As Range) 'hier kommt eine Fehlermeldung
Dim Bereich As Range
Set Bereich = Range("F1:F1000")
If Not Intersect(Target, Bereich) Is Nothing Then ' Zelle ist im Bereich
Application.EnableEvents = False
Target.Value = Wert
Application.EnableEvents = True
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Bereich As Range
Set Bereich = Range("F1:F1000")
If Not Intersect(Target, Bereich) Is Nothing Then ' Zelle ist im Bereich
Wert = Target.Value
End If


End Sub

Vielleicht kannst du noch einmal helfen?

Tschüß
Rolf


nach oben   nach unten

Re: Zelle überschreiben
von: Hajo
Geschrieben am: 08.06.2002 - 22:35:02

Hallo Rolf

mein Makro natürlich ohne Beginn und Endzeile einbauen. Also wo die Zeile wo Fehlermeldung kommt löschen.

Gruß Hajo


nach oben   nach unten

Re: Zelle überschreiben
von: Rolf
Geschrieben am: 09.06.2002 - 09:37:03

Hallo Hajo,
das Makro funktioniert einzeln super, aber nicht zusammen mit
dem anderen Makro.
Was mache ich falsch, vielleicht kannst du noch einmal helfen?

Ich möchte möchte nur erreichen, wenn eine Eingabe in Spalte F
erfolgt nichts passiert. (Zur Info: Das Ergebnis aus Spalte D und E soll in Spalte F stehen)

Option Compare Text ' Bei Vergleichen Groß-/Kleinschreibung nicht beachten
Option Explicit
Public Wert

Dim busy As Boolean

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Bereich1 As Range, Bereich2 As Range, Bereich3 As Range
Dim c As Range
Dim col As Integer
Dim AK As String
' ActiveSheet.Unprotect ("laufen")

If busy Then Exit Sub ' zum Verhindern des Selbstaufrufens durch VBA-geänderte Zellen

Set Bereich1 = Range("D2:D1000")
Set Bereich2 = Range("E2:E1000")
Set Bereich3 = Range("I2:I1000")

If Intersect(Target, Bereich1) Is Nothing And Intersect(Target, Bereich2) Is Nothing _
And Intersect(Target, Bereich3) Is Nothing Then Exit Sub

busy = True
Application.ScreenUpdating = False

For Each c In Target

If Not (Intersect(c, Bereich1) Is Nothing) Then

If c.Value = "m" Then
col = 2
ElseIf c.Value = "w" Then
col = 3
Else
c.Select
Application.ScreenUpdating = True
MsgBox "Falscher Wert"
Application.ScreenUpdating = False
col = 0
End If

ElseIf Not (Intersect(c, Bereich2) Is Nothing) Then

If Cells(c.Row, 4) = "m" Then
col = 2
ElseIf Cells(c.Row, 4) = "w" Then
col = 3
Else
col = 0
End If

ElseIf Not (Intersect(c, Bereich3) Is Nothing) Then

If (Len(c) > 6 Or InStr(c, " ") <> 0 Or InStr(c, ".") <> 0) Then
c.Select
Application.ScreenUpdating = True
MsgBox "Unzulässiger Wert"
Application.ScreenUpdating = False
End If
col = -1 ' Verhindern des Beschreibens der "AK"-Spalte

End If

If col > 0 Then
AK = ""
On Error Resume Next
AK = Application.WorksheetFunction.VLookup(Cells(c.Row, 5), _
Worksheets("Klasseneinteilung").Range("B2:D150"), col, False)
On Error GoTo 0
Cells(c.Row, 6) = AK
ElseIf col = 0 Then
Cells(c.Row, 6) = ""
End If

Next c
' ActiveSheet.Protect ("laufen")
Application.ScreenUpdating = True
busy = False

' Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range
Set Bereich = Range("F1:F1000")
If Not Intersect(Target, Bereich) Is Nothing Then ' Zelle ist im Bereich
Application.EnableEvents = False
Target.Value = Wert
Application.EnableEvents = True
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Bereich As Range
Set Bereich = Range("F1:F1000")
If Not Intersect(Target, Bereich) Is Nothing Then ' Zelle ist im Bereich
Wert = Target.Value
End If


End Sub


Vielen Dank !

Tschüß
Rolf



nach oben   nach unten

Re: Zelle überschreiben
von: Rolf
Geschrieben am: 09.06.2002 - 20:18:08

Hallo Hajo,
ich habe mein Problem gelöst.

Mit der Gültigkeitsprüfung
(Ich wußte gar nicht, das es in Excel so was gibt)

Vieln Dank nochmal für deine Unterstützung!

Tschüß
Rolf


 nach oben

Beiträge aus den Excel-Beispielen zum Thema "text in zahlen?"