Question

我正在使用此代码将数据从一个工作表传输到另一个工作表。该代码允许传输的数据保留在新工作表上直到删除。

Private Sub Transfer2_Click()
Dim Work_Order1 As String, Qty1 As Integer, Frame1 As String, Qty_Frame1 As Integer
    Worksheets("Work_Order").Select
    if Worksheets("Work_Order").Range("C12") = "" Then Exit Sub
    Work_Order1 = Range("N3")
    Qty1 = Range("B3")
    Frame1 = Range("C12").Value
    Qty_Frame1 = Range("M12")
    Worksheets("Order").Select
    Worksheets("Order").Range("A4").Select
    If Worksheets("Order").Range("A4").Offset(1, 0) <> "" Then
    Worksheets("Order").Range("A4").End(xlDown).Select
    End If
    ActiveCell.Offset(1, 0).Select
    ActiveCell.Value = Work_Order1
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Qty1
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Frame1
    ActiveCell.Offset(0, 2).Select
    ActiveCell.Value = Qty_Frame1

Private Sub Transfer2_Click()
Dim Work_Order2 As String, Qty2 As Integer, Frame2 As String, Qty_Frame2 As Integer
    Worksheets("Work_Order").Select
    if Worksheets("Work_Order").Range("C13") = "" Then Exit Sub
    Work_Order2 = Range("N3")
    Qty2 = Range("B3")
    Frame2 = Range("C13").Value
    Qty_Frame2 = Range("M13")
    Worksheets("Order").Select
    Worksheets("Order").Range("A4").Select
    If Worksheets("Order").Range("A4").Offset(1, 0) <> "" Then
    Worksheets("Order").Range("A4").End(xlDown).Select
    End If
    ActiveCell.Offset(1, 0).Select
    ActiveCell.Value = Work_Order2
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Qty2
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Frame2
    ActiveCell.Offset(0, 2).Select
    ActiveCell.Value = Qty_Frame2

Private Sub Transfer2_Click()
Dim Work_Order3 As String, Qty3 As Integer, Frame3 As String, Qty_Frame3 As Integer
    Worksheets("Work_Order").Select
    if Worksheets("Work_Order").Range("C14") = "" Then Exit Sub
    Work_Order1 = Range("N3")
    Qty3 = Range("B3")
    Frame3 = Range("C14").Value
    Qty_Frame3 = Range("M14")
    Worksheets("Order").Select
    Worksheets("Order").Range("A4").Select
    If Worksheets("Order").Range("A4").Offset(1, 0) <> "" Then
    Worksheets("Order").Range("A4").End(xlDown).Select
    End If
    ActiveCell.Offset(1, 0).Select
    ActiveCell.Value = Work_Order3
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Qty3
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Frame3
    ActiveCell.Offset(0, 2).Select
    ActiveCell.Value = Qty_Frame3

我想要做的就是结束这段代码并没有在＆＃34; C＆＃34;范围。我将代码重复了九次，因为有九个实例可以找到这些信息，但并非所有代码都会一直有值。如果发生这种情况，我希望它在将信息传输到新工作表之前结束代码。

到目前为止，我已尝试过：

if Worksheets("Work_Order").Range("C12")="" Then
Exit sub

但如果没有结束，则返回错误Block。

Answer 1

将Exit Sub放在与If不同的一行上，即表示您正在创建一个“Block If”，需要End If：

If Worksheets("Work_Order").Range("C12")="" Then
    Exit sub
End If

如果你想使用“单行If”，你应该把你的陈述放在一行：

If Worksheets("Work_Order").Range("C12")="" Then Exit sub

两个语句的工作方式完全相同，但是当您在语句的True或False段中执行多个语句时，“阻止Ifs”通常更容易编码。 / p>

E.g。

If a = 5 Then
    b = 7
    c = 10 * a - b
    d = 5 + b - c
Else
    b = 9
    c = 20 * a - 4 * b
    d = 6 + b + c
End If

比

更容易阅读

If a = 5 Then b = 7: c = 10 * a - b: d = 5 + b - c Else b = 9: c = 20 * a - 4 * b: d = 6 + b + c

在回复您的评论时，我猜测当您点击空白值时实际上并不想Exit Sub，而是希望继续处理下一个范围

这可以这样做：

Private Sub Transfer2_Click()
    Dim Work_Order1 As String, Qty1 As Integer, Frame1 As String, Qty_Frame1 As Integer
    If Worksheets("Work_Order").Range("C12").Value <> "" Then
        Worksheets("Work_Order").Select
        Work_Order1 = Range("N3")
        Qty1 = Range("B3")
        Frame1 = Range("C12").Value
        Qty_Frame1 = Range("M12")
        Worksheets("Order").Select
        Worksheets("Order").Range("A4").Select
        If Worksheets("Order").Range("A4").Offset(1, 0) <> "" Then
            Worksheets("Order").Range("A4").End(xlDown).Select
        End If
        ActiveCell.Offset(1, 0).Select
        ActiveCell.Value = Work_Order1
        ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = Qty1
        ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = Frame1
        ActiveCell.Offset(0, 2).Select
        ActiveCell.Value = Qty_Frame1
    End If
    'Then repeat for the next set of cells

可以重写，以避免使用Select（导致如此多的问题）

Private Sub Transfer2_Click()
    Dim Work_Order1 As String, Qty1 As Integer, Frame1 As String, Qty_Frame1 As Integer
    If Worksheets("Work_Order").Range("C12").Value <> "" Then
        With Worksheets("Work_Order")
            Work_Order1 = .Range("N3")
            Qty1 = .Range("B3")
            Frame1 = .Range("C12").Value
            Qty_Frame1 = .Range("M12")
        End With
        With Worksheets("Order").Cells(Worksheets("Order").Rows.Count, "A").End(xlUp).Offset(1, 0).EntireRow
            .Cells(1, "A").Value = Work_Order1
            .Cells(1, "B").Value = Qty1
            .Cells(1, "C").Value = Frame1
            .Cells(1, "E").Value = Qty_Frame1
        End With
    End If
    'Then repeat for the next set of cells

但最好是将它分成两个子程序以避免大量重复代码：

Private Sub Transfer2_Click()
    With Worksheets("Work_Order")
        Transfer2_Paste .Range("N3").Value, .Range("B3").Value, .Range("C12").Value, .Range("M12").Value
        'Then repeat for the next set of cells, e.g.
        'Transfer2_Paste .Range("N4").Value, .Range("B4").Value, .Range("C13").Value, .Range("M13").Value
        'etc
    End With
End Sub

Private Sub Transfer2_Paste(Work_Order1 As String, Qty1 As Integer, Frame1 As String, Qty_Frame1 As Integer)
    If Frame1 = "" Then
        Exit Sub
    End If
    With Worksheets("Order").Cells(Worksheets("Order").Rows.Count, "A").End(xlUp).Offset(1, 0).EntireRow
        .Cells(1, "A").Value = Work_Order1
        .Cells(1, "B").Value = Qty1
        .Cells(1, "C").Value = Frame1
        .Cells(1, "E").Value = Qty_Frame1
    End With
End Sub

如果没有找到值，请结束vba代码

1 个答案: