Question

我目前正在尝试制作一个可用于输入和存储大量数据的电子表格。加速输入数据的一种方法是从前一行复制数据。到目前为止我所拥有的是：

 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

我想要的是FillBlanks（）在第一个sub之后运行，而不必再做任何事情。所有的帮助将不胜感激。

非常感谢

Answer 1

添加

Call FillBlanks

在End Sub

的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

西瓦在他的评论中所说的话听起来是正确的，但我想举例说明其后的几点。缩进对于使代码可读并更容易理解正在发生的事情非常重要。在下面的代码中，我缩进并添加了Siva建议的更新，以及一些注释，以帮助理解代码的作用。

-U <user>

嵌套的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（更容易看到缩进）意味着，例如，F13-F14 FillBlank只有在所有之前的其他人也是空白时才会运行。< / p>

我不确定这是做到这一点的最佳方式，也可能是您尝试实现的目标。我想建议一些可能有帮助的选项： -

<强> 1。如果F13为空，则全部复制

If

<强> 2。只复制空的，不管周围的那些

Sub FillBlanks()

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

End Sub

在第二个中我使用了一个功能，如果要运行的语句是一行，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可以省略

这可能是一个轻微的代码审查，但希望它已经作为一种教育并回答了这个问题。

如果单元格值已更改则运行不同的If语句

3 个答案: