Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1364to1368
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
Inhaltsverzeichnis

Target-Anweisung mit Multiplikation erweitern

Target-Anweisung mit Multiplikation erweitern
19.06.2014 13:10:44
Klaus Lang

Hallo Excelfreunde,
ich habe mir die nachstehende Prozedur von Hajo "zurecht gepfriemelt" (DANKE Hajo!) und möchte gerne die Zeile "Cells(Target.Row, 8) = Target.Column - 3" ergänzen mit einer Multiplikation einer jeweils in der Spalte B stehenden Zahl. Aber ich komme nicht weiter mit
"Cells(Target.Row, 8) = Target.Column - 3 * Selection.Offset(0, -6).Value" oder
"Cells(Target.Row, 8) = Target.Column - 3 * Target.Column 2".

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column > 3 And Target.Column < 8 And Target.Row > 8 Then
ActiveSheet.Unprotect
' damit Cursor nicht in Zelle nach Doppelklick
Cancel = True
' vorhandene Haken löschen im Bereich
Range("D" & Target.Row & ":H" & Target.Row).Value = ""
With Target
.Value = "a"                            ' Buchstabe a eintragen
.Font.Name = "Webdings"                 ' Schriftart
End With
' in Spalte H entsprechend Auswahl Wertigkeit eintragen
Cells(Target.Row, 8) = Target.Column - 3
'ActiveSheet.Protect
End If
End Sub
Vielen Dank schon mal vorab.

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Target-Anweisung mit Multiplikation erweitern
19.06.2014 13:44:52
Hajo_Zi
Cells(Target.Row, 2)

AW: Target-Anweisung mit Multiplikation erweitern
19.06.2014 14:40:00
Klaus Lang
Hallo Hajo,
vielen, vielen Dank! Ich habe die Prozedur entspr. angepasst und etwas verändert (ist vielleicht auch für Dich interessant).
Könntest Du mir bitte helfen, die unelegante Lösung für den automatischen Eintrag der Leerkästchen, unter der Bedingung dass in Spalte C Text steht, VBA-gerechter zu gestalten?
Hier die Prozedur:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If IsEmpty(Cells(Target.Row, 3)) Then
MsgBox "Es fehlt der zu beurteilende Text", vbExclamation, "Jetzt nicht möglich"
Cells(Target.Row, 3).Select
Else
If Target.Column > 3 And Target.Column < 8 And Target.Row > 8 Then
ActiveSheet.Unprotect
' damit Cursor nicht in Zelle nach Doppelklick
Cancel = True
' vorhandene Kästchen löschen und setzen im Bereich
Range("D" & Target.Row & ":H" & Target.Row).Value = ""
With Target
.Font.Name = "Wingdings 2"
.Value = "T"
End With
' in Spalte H entsprechende Auswahl Wertigkeit * Gewichtung in Spalte B
Cells(Target.Row, 8) = Target.Column - 3 * Cells(Target.Row, 2)
'  End If
'In die anderen Zellen der Zeile Leerkästchen eintragen
'(SOFERN Spalte C Text enthält)
If Target.Column = 4 Then
Target.Offset(0, 1).Value = "*"
Target.Offset(0, 2).Value = "*"
Target.Offset(0, 3).Value = "*"
ElseIf Target.Column = 5 Then
Target.Offset(0, -1).Value = "*"
Target.Offset(0, 1).Value = "*"
Target.Offset(0, 2).Value = "*"
ElseIf Target.Column = 6 Then
Target.Offset(0, 1).Value = "*"
Target.Offset(0, -1).Value = "*"
Target.Offset(0, -2).Value = "*"
ElseIf Target.Column = 7 Then
Target.Offset(0, -1).Value = "*"
Target.Offset(0, -2).Value = "*"
Target.Offset(0, -3).Value = "*"
End If
End If: End If
'ActiveSheet.Protect
End Sub
Ach ja, soeben aufgefallen. Die Multiplikation mit "Cells(Target.Row, 2)" bringt nur ein korrektes Ergebnis mit der Zahl 1! Woran liegt das?
Danke vorab!
Gruß Klaus

Anzeige
AW: Target-Anweisung mit Multiplikation erweitern
19.06.2014 14:48:18
Hajo_Zi
Hallo Klaus,
ich kann nicht sehen wo Du auf Text prüfst.
Deine Tabelle ist am Ende nicht geschützt.
Zu dem Ergebnis kann ich nichts schreiben, was wohl daran liegt das ich die Datei nicht sehe.
Bei mir wird eine Zahl eingetragen.
Gruß Hajo

AW: Target-Anweisung mit Multiplikation erweitern
19.06.2014 15:15:28
Hajo_Zi
Hallo Klaus,
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If IsEmpty(Cells(Target.Row, 3)) Then
MsgBox "Es fehlt der zu beurteilende Text", vbExclamation, "Jetzt nicht möglich"
Cells(Target.Row, 3).Select
Else
If Target.Column > 3 And Target.Column < 8 And Target.Row > 8 Then
ActiveSheet.Unprotect
' damit Cursor nicht in Zelle nach Doppelklick
' vorhandene Kästchen löschen und setzen im Bereich
Range("D" & Target.Row & ":H" & Target.Row).ClearContents
With Target
.Font.Name = "Wingdings 2"
.Value = "T"
End With
' in Spalte H entsprechende Auswahl Wertigkeit * Gewichtung in Spalte B
Cells(Target.Row, 8) = Target.Column - 3 * Cells(Target.Row, 2)
'  End If
'In die anderen Zellen der Zeile * eintragen, sofern Spalte C Text enthält
If Target.Column >= 4 And Target.Column <= 7 And IsNumeric(Cells(Target.Row, 3)) =  _
False Then
Range(Target.Offset(0, 1), Target.Offset(0, 3)) = "*"
Range(Target.Offset(0, 1), Target.Offset(0, 3)).Font.Name = Application. _
StandardFont
End If
ActiveSheet.Protect
End If
End If
Cancel = True
End Sub
Gruß Hajo

Anzeige
AW: Target-Anweisung mit Multiplikation erweitern
19.06.2014 17:20:22
Klaus Lang
Hallo Hajo,
vielen Dank schon mal, aber es gibt noch Problemchen.
Die "elegantere" Lösung mit "If Target.Column >= 4 And Target.Column <= 7 ..." klappt zwar in Spalte D, aber wenn der Doppelklick in den Spalten E, F und G erfolgt, verschieben sich die Kästchen nach rechts und der Wertigkeitswert wird "übermalt". Ich würde allerdings mit meiner unprofessionellen Lösung auch zurecht kommen. Wenn also nichts mehr kommt, bin ich dennoch sehr dankbar für die bisherige Hilfe.
Gruß Klaus

AW: Target-Anweisung mit Multiplikation erweitern
19.06.2014 17:25:32
Hajo_Zi
Hallo K´laus,
dann baue an der Stelle wieder den alten Code ein, das hatte ich überlesen.
Gruß Hajo

Anzeige
AW: Target-Anweisung mit Multiplikation erweitern
19.06.2014 17:30:57
Hajo_Zi
Hallo Klaus,
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If IsEmpty(Cells(Target.Row, 3)) Then
MsgBox "Es fehlt der zu beurteilende Text", vbExclamation, "Jetzt nicht möglich"
Cells(Target.Row, 3).Select
Else
If Target.Column > 3 And Target.Column < 8 And Target.Row > 8 Then
ActiveSheet.Unprotect
' damit Cursor nicht in Zelle nach Doppelklick
' vorhandene Kästchen löschen und setzen im Bereich
Range("D" & Target.Row & ":H" & Target.Row).ClearContents
If IsNumeric(Cells(Target.Row, 3)) = False Then
Range(Cells(Target.Row, 4), Cells(Target.Row, 7)) = "*"
Range(Cells(Target.Row, 4), Cells(Target.Row, 7)).Font.Name = Application. _
StandardFont
End If
With Target
.Font.Name = "Wingdings 2"
.Value = "T"
End With
ActiveSheet.Protect
End If
End If
Cancel = True
End Sub
Gruß Hajo

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige