Wie kann Makros auf mehrere Zellen anwenden?

Hallo zusammen

Ich habe von einem von euch diesen Code für mein Problem erhalten.

Public dMerk As Double

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$A$7" And IsNumeric(Target) Then

Application.EnableEvents = False

On Error Resume Next

Range("A7").Value = dMerk + Target.Value

dMerk = Range("A7").Value

Application.EnableEvents = True

On Error GoTo 0

End If

End Sub

Jetzt möchte ich diesen jedoch nicht nur auf diese eine Zellle anwenden, sondern auf viele verschiedene. Wie kann ich das machen ohne für jede Zelle das Makro kopieren und den Bezug ändern muss.

Danke im voraus

2 Antworten

Oubyi, UserMod Light

Von gutefrage auf Grund seines Wissens auf einem Fachgebiet ausgezeichneter Nutzer

Microsoft Excel

06.11.2019, 21:02

Teste mal:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:C5")) Is Nothing Then 'Bereich (range) anpassen
 If IsNumeric(Target) Then
  Application.EnableEvents = False
  On Error Resume Next
  Target.Value = dMerk + Target.Value
  dMerk = Target.Value
  Application.EnableEvents = True
  On Error GoTo 0
 End If
End If
End Sub

Woher ich das weiß:Berufserfahrung – IT-Administrator (i.R.)

Noxy00

Fragesteller

07.11.2019, 19:37

Ok, danke vielmals. ALso muss ich eigentlich nur bei Range den Bereich eingeben den ich haben will? Wenn ich das so mache funktionierts irgendwie nicht.

Oubyi, UserMod Light

07.11.2019, 20:30

@Noxy00

funktionierts irgendwie nicht.

Das ist eine sehr ungenaue Beschreibung eine Fehlers.
Beschreibe das bitte ganz genau, sonst kann ich Dir nicht helfen.
Hast Du den Code genau SO übernommen oder angepasst? Wenn ja, wie?

Iamiam

Von gutefrage auf Grund seines Wissens auf einem Fachgebiet ausgezeichneter Nutzer

Microsoft Excel

08.11.2019, 01:44

Bette das ein in

Dim C

For each C in Selection

...

next C

und ersetze alle Target durch C

Hallo,

Excel-VBA....

ich benötige Hilfe beim Thema UserForm öffnen und ständige Abfrage.

Ich habe eine Zelle mit einer Formel, der Wert, welcher raus kommt soll verglichen werden und bei z.b höher als 2 soll eine User Form geöffnet werden.

Kann mir da wer helfen? Ich bin komplett auf dem Holzweg..

Der Code:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$T$6" Then
If UCase(Target.Value) > 2 Then NewUserForm.Show
End If

End Sub

Devo

...zur Frage

Richtig Einfügen in Excel-VBA?

Ich bin mir auch nicht sicher ob ich Richtig in VBA einfüge, der Sub Kopieren funktioniert nicht.

Mein Code:

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("E8")) Is Nothing Then

Cells.EntireRow.Hidden = False

If Range("E8").Value = "Rogo AC" Then

Columns("U:AH").Hidden = True

Columns("U").Hidden = False

ElseIf Range("E8").Value = "Shunt 100A" Then

Columns("U:AH").Hidden = True

Columns("V").Hidden = False

End If

End Sub

-------------------------------------------------------------------------------------------------------------------------------

Sub Kopieren_speichern()

For i = 27 To 37

If Range("AK" & i).Value > 1 Then

Range("M" & i).Value = Range("AK" & i).Value

End If

Next i

End Sub

Danke im Voraus

...zur Frage

Exel VBA? wert automatisch löschen?

Folgenden Code habe ich..

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$E$5" Then

Range("G5").Value = Range("G5").Value + Target.Value

End If

End Sub

Wie bekomme ich es hin, das sich nach eingabe von E5 der wert automatisch wieder löscht?

danke schon mal

...zur Frage

Excel, Zellinhalte sollen automatisch nach unten "rutschen"

Hi,

ich versuche folgendes:

Eintrag in Zelle A10 soll automatisch in Zelle A11 eingetragen werden und jeder weitere Eintrag in A10 ebenso. Die bereits vorhanden Einträge sollen dabei nach unten verschoben werden. Das selbe will ich auch in der Spalte B, C, D... usw machen. Für die Spalte A hab ich es schon geschafft, allerdings bekomme ich für die weiteren Spalten nicht hin. Kann mir jemand helfen...wäre echt super....

Soweit bin ich schon:

Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo ErrorHandler

If Not Intersect(Target, Range("A1")) Is Nothing Then

Range("B65536").End(xlUp).Offset(1, 0).Value = Target.Value

Application.EnableEvents = False

Target.Value = ""

Target.Select

ErrorHandler:

Application.EnableEvents = True

End If

End Sub

...zur Frage

Excel-Code für Mehrfachauswahl in Dropdown-Listen?

Hallo zusammen,

Ich versuche gerade ein Excel-Dokument zu erstellen, bei dem eine Mehrfachauswahl aus Dropdown-Listen möglich ist. Das heißt aus einer Liste sollte es möglich sein mehrere Werte anzuwählen. Das habe ich auch mit dem untenstehenden VisualBasic-Code gemeistert. Allerdings habe ich erstens das Problem, dass auch eine Mehrfachauswahl des immer gleichen Wertes möglich ist. Theoretisch könnte also in einer Zelle x-mal derselbe Werte auftauchen. Dies soll natürlich nicht möglich sein. Bei Doppelauswahl desselben Wertes soll dieser aus der Zelle wieder verschwinden.

Mein zweites Problem ist, dass ich bislang nur 2 zwei Dropdown-Listen mit Mehrfachauswahl eingefügt bekomme. Sobald ich eine dritte Spalte versuche zu implementieren, bekomme ich eine Fehlermeldung für meinen Code.

Dadurch, dass ich mich mit dem Ganzen nicht so wirklich auskenne, wäre es sehr nett, wenn mir jemand helfen könnte.

Danke!

Bisheriger Code:

Private Sub Worksheet_Change(ByVal Target As Range)

** Mehrfachauswahl über DropDown-Liste

'** Einfügen im Code-Container des betreffenden Arbeitsblattes

'** Dimensionierung der Variablen

Dim rngDV As Range

Dim wert_old As String

Dim wertnew As String

'** Errorhandling

On Error GoTo Errorhandling

'** Mehrfachauswahl im definierten Bereich "Abteilungen" und "Themen" (Bsp. J2:J2000, I2:I2000) durchführen

If Not Application.Intersect(Target, Range("J2:J2000", "I2:I2000")) Is Nothing Then

'**Range definieren

Set rngDV = Target.SpecialCells(xlCellTypeAllValidation)

If rngDV Is Nothing Then GoTo Errorhandling

'** Prüfen, ob eine gültige Zelle ausgewählt wurde und Werte eintragen

If Not Application.Intersect(Target, rngDV) Is Nothing Then

Application.EnableEvents = False

wertnew = Target.Value

Application.Undo

wertold = Target.Value

Target.Value = wertnew

If wertold <> "" Then

If wertnew <> "" Then

Target.Value = wertold & ", " & wertnew

End If

Application.EnableEvents = True

End If

Errorhandling:

Application.EnableEvents = True

End Sub

...zur Frage

Excel if target.column?

Hallo zusammen,

habe mal wieder ein problem mit excel.... im nachfolgenden code geht alles soweit bis auf die zwei if cods bzw. der eine der sich auf die 4 ("D") Zeile bezieht geht. der code der auf zeile 9 gerichtet ist geht einfach nicht... wenn ich anstelle 9, 8 angebe und ändere gehts. es gehen alle spalten bis auf 8. dann is sense...

kann es sein, dass nur 8 zeilen irgendwie unterstützt werden oder hab ich da was falsch gemacht?

Option Explicit
Sub Worksheet_Change(ByVal Target As Range)
   
   If IsEmpty(Target) Then Exit Sub
   If Intersect(Target, Range("a2:h100")) _
      Is Nothing Then Exit Sub
   Application.EnableEvents = False
   On Error GoTo ERRORHANDLER
   Target = UCase(Target)
ERRORHANDLER:
   Application.EnableEvents = True

    If Target.Column = 4 Then Call Zelle11 ' Heim
    
    If Target.Column = 9 Then Call Zelle12 ' Gast
    
    
End Sub

...zur Frage

Excel: Verbessertes Logging mit VBA Makro?

Hallo Zusammen

ich verwende im Moment ein kurzes Makro, um Änderungen in einem Tabellenblatt zu loggen.

Es registriert aber nur einzelne Änderungen, nicht multi-selektion oder Löschen von Spalten. Kann ich das mit separaten Privaten Subs übernehmen?

Und kann ich aufnehmen, was die Target- und "PreVal"-Adresse war (Offset 4+5)

Code:

Dim PreVal
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
PreVal = Target.Value
 
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
  
    On Error GoTo 0
    
    If Target.Value <> PreVal Then
        With Sheets(2).Cells(Rows.Count, 1).End(xlUp)
            .Offset(1, 0) = Now
            .Offset(1, 1) = PreVal
            .Offset(1, 2) = Target.Value
            .Offset(1, 3) = Environ("Username")
        End With
    End If
 
End Sub

...zur Frage

Excel Arbeitsmappe separat speichern mit VBA?

Hallo,

habe bei meiner Exceldatei 10 Arbeitsmappen und ich möchte eine Arbeitsmappe davon separat als Datei abspeichern sodass ich unten nur mehr eine Arbeitsmappe stehen habe.

Habe mir hierfür einen einen Knopf erstellt und mit VBA den Knopf programmiert. Wenn ich ihn drücke, dann habe ich es bereits geschafft, dass die Mappe sich als PDF exportiert aber als Excel ist nicht möglich. Hier ist mein Code:

Sub EXCEL_erstellen()

Dim DateiName As String

DateiName = Range("AB3") & Range("AB2")

Range("A1:T61").ExportAsFixedFormat Type:=xlTypeXPS, Filename:=DateiName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

End Sub

...zur Frage

Excel VBA Button Enable?

Hallo Freunde,

Ich habe einen Button in Excel implementiert, der sichtbar sein soll wenn meine Zelle A1 die Zahl 2 enthält.

Der Code dafür lautet:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
  On Error GoTo ErrHandler
  Dim rngButton1 As Integer
  rngButton1 = A1
  If rngButton1 = 2 Then
  CommandButton1.Enabled = False
  Else
  CommandButton1.Enabled = True
  End If
  Application.EnableEvents = True
Exit Sub
ErrHandler:
Application.EnableEvents = True
End Sub

Der Code funktioniert an und für sich, es kommt zu keiner Fehlermeldung.
Aber der Button bleibt egal was ich einstelle, Sichtbar.

Wo liegt der Fehler?

...zur Frage

Name + User?

Hallo,

was müsste ich hier anpassen? Ich komme mit der Fehler Meldung nicht zurecht.

Private Declare 36 GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Function GetNTUserA() As String
  
 Dim sBuffer As String
 Dim LSize As Long
 Dim user As String
  
 sBuffer = Space$(255)
 LSize = Len(sBuffer)
  
 Call GetUserName(sBuffer, LSize)
  
 If LSize > 0 Then
  user = Left$(sBuffer, LSize - 1)
 Else
  user = vbNullString
 End If
  
 GetNTUserA = user
  
End Function
Private Sub Worksheet_Change(ByVal Target As Range)
   
    If Target.Column = 6 Then
    Target.Offset(0, 11).Value = Date
  End If
      
    If Target.Column = 6 Then
    Target.Offset(0, 10).Value = GetNTUserA
  End If

End Sub

...zur Frage

Beim ändern einer bestimmten Zelle Makro erneut ausführen?

Hallo,

ich habe folgendes Anliegen: Ich möchte in Excel mit VBA etwas machen. Hier einmal der Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("j10")) Is Nothing Then
    Select Case Range("j10").Value
        Case "manuell"
            Range("s7:u7").ClearContents
        Case "Anfang & Ende"
            Range("s7").Value = Worksheets("PEPStauchung").Range("d2").Value
    End Select
End If
End Sub

Ich möchte, dass, wenn ich in Zelle S6 einen Wert ändere, das ganze erneut durchgeführt wird.

Wie binde ich das ein? Vielen Dank!!!

Syrena

...zur Frage

Excel VBA Private Sub Worksheet_Change(ByVal Target As Range)? Help Programm vom Kollegen Bearbeitet

Habe für einen Kollegen ein Programm geschrieben. Das Problem ist nun das er vorher als Change Bedienung einen Befehl drin hat denn ich nicht ganz verstehe(und mein Programm Stört). :/ Der Code hat seinen Sinn deswegen möchte ich ihn gerne drin lassen. Hier der Code:

Private Sub Worksheet_Change(ByVal Target As Range)
   If Intersect(Target, Range("A7:A100")) Is Nothing Then Exit Sub
   If Target.Value <> "" Then
      Target.Offset(0, 8).Value = Date
   Else
      Target.Offset(0, 8).ClearContents
   End If

End Sub

Ich denke der Code Funktioniert so. Er Speichert in der Variable "Target" die Range A7;A100 und guck nun dann ob sie leer sind wenn ja soll er das Sub Verlassen. Ist das gebiet 0,8 nicht "ungleich" Leer soll es in die Zelle 0,8 bzw "Offset"? Das Datum reinschreiben. Ist Target 0,8 leer? Löscht es die Komplette Zeile?...

So das Programm erzeugt immer wenn man in Spalte A in eine neue Zeile schreibt an der stelle 8/bzw. H das Datum.

Das Problem ist aber das der Debugger anspringt wenn man Zeilen per Rechtsklick Zeilen Löschen rauslöscht. Und da das wiederum unschön ist wäre hilfe wirklich schön :)

mfg Dennis

...zur Frage

Excel VBA Selection begrenzen?

Hallo zusammen.

Ich komme leider beim meinem Problem nicht alleine weiter.

In meiner Tabelle werden in Spalte 2 und Zeile 4 Zeichen angezeigt, sobald ein Bereich selektiert wird. Die Zeichen sollen sich allerdings nur auf die Range J7:OJ57 beschränken, auch wenn die Selektion über die Range hinausgeht.

Denn jetzt, wenn ich z.B. eine Spalte markiere, schreibt der Code mir alle Zeichen in jede Zeile der Spalte, was fatal ist.

Kann ein Profi kurz helfen? :)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("J6:OJ57")) Is Nothing Then
Dim cell As Range
  Application.Calculation = xlCalculationManual
  Application.ScreenUpdating = False
  Application.EnableEvents = False
   Range("B6:B57").ClearContents
   Range("J4:OJ4").ClearContents
For Each cell In selection
  With cell
   Range(cell(.Row, 2), Cells(.Row, 2)) = ">>"
   Range(cell(4, .Column), Cells(4, .Column)) = "V"
  End With
Next
   Application.ScreenUpdating = True
   Application.EnableEvents = True
   Application.Calculation = xlCalculationAutomatic
End If
End Sub

...zur Frage

Target.Address Fehlermeldung Laufzeitfehler "424": Objekt erforderlich?

Hallo,

ich verschiedene Befehle mit VBA realisieren, um eine Auswahlliste anzupassen. Zum einen sollen Zellen ausgeblendet werden, wenn eine bestimmte Zelle leer ist und daher ein ganzer Teil der Liste entfallen kann. Der Befehl sieht folgendermaßen aus:

Sub HdlZellenVerbergen()

If Target.Address = "$C$9" Then

If C9 = "" Then

Rows("164:195").Hidden = True

Else

Rows("164:195").Hidden = False

End If

End Sub

Da ich mich nun Hals über Kopf in VBA geschmissen habe und schon einige Male Internetrecherche betrieben habe, weiß ich nicht wo der Fehler liegt, da mir hier die Erfahrung fehlt. Der Fehler lautet wie in der Überschrift angegeben. Was muss ich machen, damit das ganze nun funktioniert.

Ein ähnliches Problem erwarte ich dann bei folgendem Code:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$C$8" Then

If [C8] = "x" Then [D22] = "y"

End If

End Sub

Auch hier wäre eine Hilfe super.

Vielen Dank im Voraus.

...zur Frage

Was möchtest Du wissen?

Deine Frage stellen