Wenn der Zellenwert geändert wird, dann verschiedene If-Anweisungen ausführen

Question

Ich versuche gerade, eine Tabelle zu erstellen, mit der große Datenmengen eingegeben und gespeichert werden können. Eine Möglichkeit, den Dateneingabeprozess zu beschleunigen, besteht darin, Daten aus der vorherigen Zeile zu kopieren. Bisher, was ich habe ist:

Private Sub Worksheet_Change(ByVal Target As Range) 

If Target.Address = "$J$3" Then 

Call LD_Copy_Paste_Delete 

End If 

End Sub 

Sub FillBlanks() 

If Range("B13").Value = Empty Then 
    Range("B14").Selects 
    Selection.Copy 
    Range("B13").Select 
    ActiveSheet.Paste 
    Range("B13").Select 
    Application.CutCopyMode = False 

If Range("C13").Value = Empty Then 
    Range("C14").Select 
    Selection.Copy 
    Range("C13").Select 
    ActiveSheet.Paste 
    Range("C13").Select 
    Application.CutCopyMode = False 

If Range("D13").Value = Empty Then 
    Range("D14").Select 
    Selection.Copy 
    Range("D13").Select 
    ActiveSheet.Paste 
    Range("D13").Select 
    Application.CutCopyMode = False 


If Range("E13").Value = Empty Then 
    Range("E14").Select 
    Selection.Copy 
    Range("E13").Select 
    ActiveSheet.Paste 
    Range("E13").Select 
    Application.CutCopyMode = False 


If Range("F13").Value = Empty Then 
    Range("F14").Select 
    Selection.Copy 
    Range("F13").Select 
    ActiveSheet.Paste 
    Range("F13").Select 
    Application.CutCopyMode = False 

    End If 
    End If 
    End If 
    End If 
    End If 

End Sub 

Was würde Ich mag es, für die FillBlanks() laufen kurz nach dem ersten Teil, ohne mehr etwas zu tun. Alle Hilfe wäre willkommen.

Vielen Dank

Answer 1

Fügen Sie einfach

Call FillBlanks 

direkt vor dem End Sub von Worksheet_Change

Answer 2

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim cl as Range 

    If Target.Address = "$J$3" Then 
     Call LD_Copy_Paste_Delete 
    End If 

    For each cl in Range("B13:F13") 
     If cl = "" Then 
      cl = cl.Offset(1, 0) 
     End if 
    Next cl 
End Sub 

Answer 3

Was Siva in seinem Kommentar heißt es richtig klingt, aber ich möchte ein paar Punkte über exemplifizieren es. Einrückung ist wichtig, um den Code lesbar zu machen und zu verstehen, was passiert. Im folgenden Code habe ich das Update eingerückt und hinzugefügt, wie es Siva vorschlägt, zusammen mit einer Reihe von Kommentaren, um das Verständnis dessen zu verbessern, was der Code tut.

Private Sub Worksheet_Change(ByVal Target As Range) 

'When the user changes the selection to cell J3 then do the work 
If Target.Address = "$J$3" Then 
    'Adding a line to run fill blanks as Siva suggested 
    FillBlanks 
    Call LD_Copy_Paste_Delete 
End If 

End Sub 

Sub FillBlanks() 

If Range("B13").Value = Empty Then 
    Range("B14").Select 'There was an extra 's' here that would never have worked 
    Selection.Copy 
    Range("B13").Select 
    ActiveSheet.Paste 
    Range("B13").Select 
    Application.CutCopyMode = False 

    If Range("C13").Value = Empty Then 
     Range("C14").Select 
     Selection.Copy 
     Range("C13").Select 
     ActiveSheet.Paste 
     Range("C13").Select 
     Application.CutCopyMode = False 

     If Range("D13").Value = Empty Then 
      Range("D14").Select 
      Selection.Copy 
      Range("D13").Select 
      ActiveSheet.Paste 
      Range("D13").Select 
      Application.CutCopyMode = False 

      If Range("E13").Value = Empty Then 
       Range("E14").Select 
       Selection.Copy 
       Range("E13").Select 
       ActiveSheet.Paste 
       Range("E13").Select 
       Application.CutCopyMode = False 

       If Range("F13").Value = Empty Then 
        Range("F14").Select 
        Selection.Copy 
        Range("F13").Select 
        ActiveSheet.Paste 
        Range("F13").Select 
        Application.CutCopyMode = False 
       End If 
      End If 
     End If 
    End If 
End If 

End Sub 

Die verschachtelten If s (die mit Vertiefung klarer zu sehen sind) bedeutet, dass zum Beispiel die F13-F14 FillBlank wird nur dann ausgeführt, wenn alle andere vor als auch leer waren.

Ich bin mir nicht sicher, ob dies der beste Weg ist, dies zu tun oder was Sie vielleicht versucht haben zu erreichen. Ich möchte einige andere Optionen vorschlagen, die hilfreich sein können: -

1. Kopieren Sie alle, wenn F13

Sub FillBlanks() 

If Range("F13")= "" Then 
    Range("B14:F14").Copy Range("B13:F13") 
End If 

End Sub 

2. Kopieren Sie nur leere leer ist, unabhängig von umgebenden diejenigen

Sub FillBlanks() 

If Range("B13") = "" Then Range("B14").Copy Range("B13") 
If Range("C13") = "" Then Range("C14").Copy Range("C13") 
If Range("D13") = "" Then Range("D14").Copy Range("D13") 
If Range("E13") = "" Then Range("E14").Copy Range("E13") 
If Range("F13") = "" Then Range("F14").Copy Range("F13") 

End Sub 

im zweiten ich die Funktion verwendet haben, wo End If verzichtet werden kann, wenn die Aussage ist

eine einzige Zeileausgeführt werden

Dies könnte eine leichte Übercode Überprüfung gewesen sein, aber hoffentlich hat es als eine Ausbildung gedient und die Frage auch beantwortet.