Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
124to128
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
124to128
124to128
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Zelle überschreiben

Zelle überschreiben
08.06.2002 08:16:01
Rolf
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

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Re: Zelle überschreiben
08.06.2002 08:23:20
Hajo
Hallo Rolf

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

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

Gruß Hajo

Re: Zelle überschreiben
08.06.2002 11:25:03
Hans W. Hofmann
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

Re: Zelle überschreiben
08.06.2002 11:29:42
Hans W. Hofmann
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



Anzeige
Re: Zelle überschreiben
08.06.2002 20:49:08
Rolf
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

Anzeige
Re: Zelle überschreiben
08.06.2002 21:00:12
Hajo
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

Re: Zelle überschreiben
08.06.2002 22:32:18
Rolf
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


Anzeige
Re: Zelle überschreiben
08.06.2002 22:35:02
Hajo
Hallo Rolf

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

Gruß Hajo

Re: Zelle überschreiben
09.06.2002 09:37:03
Rolf
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



Anzeige
Re: Zelle überschreiben
09.06.2002 20:18:08
Rolf
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

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige