Microsoft Excel

Herbers Excel/VBA-Archiv

Debuggen


Betrifft: Debuggen
von: Peach123
Geschrieben am: 16.04.2018 13:29:45

Hallo meine Lieben,

ich hoffe ihr könnt mir eventuell helfen.

Ich besitze zwei identische Mappen.

Wenn ich in Mappe2 die formeln "überschreibe", sollen diese nach dem Löschen aus Mappe1 wieder hergestellt werden.

Nur bekomme ich ständig eine Fehlermeldung. Bei der ich leider nicht mehr weiter weiß.

Könnte mir jemand helfen?

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Bereich           As Range
   With Sheet("ActiveSheet")
      Set Bereich = Range("A7:Q66")
      If Not Intersect(Target, Bereich) Is Nothing Then
         If IsEmpty(Target) Then
           Target.Formula = Sheets("Formelblatt").Range(Target.Address).Formula
         End If
      End If
    End With
End Sub

  

Betrifft: Was für eine Fehlermeldung? (owT)
von: EtoPHG
Geschrieben am: 16.04.2018 13:34:43




  

Betrifft: With Sheet("ActiveSheet")
von: ChrisL
Geschrieben am: 16.04.2018 13:51:22

Hi

Default ist sowieso ActiveSheet und kann darum weg.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bereich           As Range
       Set Bereich = Range("A7:Q66")
       If Not Intersect(Target, Bereich) Is Nothing Then
          If IsEmpty(Target) Then
            Target.Formula = Sheets("Formelblatt").Range(Target.Address).Formula
          End If
       End If
 End Sub

cu
Chris


  

Betrifft: AW: With Sheet("ActiveSheet")
von: Peach123
Geschrieben am: 16.04.2018 14:47:15

Vielen Dank für die schnelle Antwort.

Nun aber nimmt er die hervorgehobene Zeile nicht mehr:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bereich           As Range
       Set Bereich = Range("A7:Q66")
       If Not Intersect(Target, Bereich) Is Nothing Then
          If IsEmpty(Target) Then
            Target.Formula = Sheets("Formelblatt").Range(Target.Address).Formula
          End If
       End If
 End Sub
Der Rest des Codes sieht folgendermaßen aus:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngDV As Range
Application.EnableEvents = False
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo 0
If rngDV Is Nothing Then Exit Sub
If Intersect(Target, rngDV) Is Nothing Then
ActiveWindow.Zoom = 90
Else
ActiveWindow.Zoom = 130
End If
Application.EnableEvents = True
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
If Not Intersect(Target, Range("A4:A66")) Is Nothing Then
  Target = IIf(Target = "", "x", IIf(Target = "x", "", ""))
  Cancel = True
End If
End Sub

Kann es eventuell daran liegen?


  

Betrifft: Beispieldatei
von: ChrisL
Geschrieben am: 16.04.2018 15:01:27

Hi

Kann ich so nicht rekonstruieren. Bitte Beispieldatei.

cu
Chris


  

Betrifft: AW: Beispieldatei
von: Peach123
Geschrieben am: 16.04.2018 15:18:42

http://www.herber.de/bbs/user/121069.xlsm

Vielen Dank für deine Hilfe.

Hab meine Datei soeben hochgeladen :)


  

Betrifft: verbundene Zellen
von: ChrisL
Geschrieben am: 16.04.2018 16:08:45

Hi

Die verbundenen Zellen stören. Zudem hast du auch Zellen ohne Formeln, was ggf. zur Endlosschleife führen kann.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bereich As Range
    Dim c As Range
      
    Set Bereich = Range("A7:Q66")
    For Each c In Target.Cells
    If Not Intersect(c, Bereich) Is Nothing Then
       If IsEmpty(c) Then
         On Error Resume Next
         Application.EnableEvents = False
         c.Formula = Sheets("Formelblatt").Range(c.Address).Formula
         Application.EnableEvents = True
         On Error GoTo 0
       End If
    End If
    Next c
 End Sub
cu
Chris