Excel VBA 宏代码中的未知错误答案

【问题标题】：Unknown error in Excel VBA Macro codeExcel VBA 宏代码中的未知错误
【发布时间】：2018-03-15 17:03:24
【问题描述】：

我对 VBA 还是很陌生，基本上是自学成才。我为工作开发了一个电子表格，我需要一个宏来允许客户添加信息，然后将信息按降序复制到工作表 2。这是我当前尝试使用的代码，但是当我单击“保存”宏按钮时，数据在两次输入后停止复制。此外，是否可以输入一些代码来清除块，这样每个新客户都看不到前一个客户输入的内容？

Private Sub CommandButton1_Click()
Dim Name As String, Org As String, POCPhone As String, Email As String, TypeofVeh As String, TotPax As String, TotCar As String, Pickup As String, DateReq As String, DateRet As String, Destination As String, YN As String, Remarks As String
   Worksheets("TransReq").Select
   Name = Range("B4")
   Org = Range("C4")
   POCPhone = Range("D4")
   Email = Range("E4")
   TypeofVeh = Range("F4")
   TotPax = Range("G4")
   TotCar = Range("H4")
   Pickup = Range("I4")
   DateReq = Range("J4")
   DateRet = Range("K4")
   Destination = Range("L4")
   YN = Range("M4")
   Remarks = Range("N4")
   Worksheets("TransReqLog").Select
   Worksheets("TransReqLog").Range("B3").Select
   If Worksheets("TransReqLog").Range("B3").Offset(1, 1) <> "" Then
   Worksheets("TransReqLog").Range("B3").End(xlDown).Select
   End If
   ActiveCell.Offset(1, 0).Select
   ActiveCell.Value = Name
   ActiveCell.Offset(0, 1).Select
   ActiveCell.Value = Org
   ActiveCell.Offset(0, 1).Select
   ActiveCell.Value = POCPhone
   ActiveCell.Offset(0, 1).Select
   ActiveCell.Value = Email
   ActiveCell.Offset(0, 1).Select
   ActiveCell.Value = TypeofVeh
   ActiveCell.Offset(0, 1).Select
   ActiveCell.Value = TotPax
   ActiveCell.Offset(0, 1).Select
   ActiveCell.Value = TotCar
   ActiveCell.Offset(0, 1).Select
   ActiveCell.Value = Pickup
   ActiveCell.Offset(0, 1).Select
   ActiveCell.Value = DateReq
   ActiveCell.Offset(0, 1).Select
   ActiveCell.Value = DateRet
   ActiveCell.Offset(0, 1).Select
   ActiveCell.Value = Destination
   ActiveCell.Offset(0, 1).Select
   ActiveCell.Value = YN
   ActiveCell.Offset(0, 1).Select
   ActiveCell.Value = Remarks
   Worksheets("TransReq").Select
   Worksheets("TransReq").Range("B4").Select


End Sub

【问题讨论】：

它会抛出错误消息还是停止复制？

标签： vba excel

【解决方案1】：

“两次输入后数据停止复制。” - 这意味着它停在这里 - ActiveCell.Value = POCPhone 一个可能的原因应该是，POCPhone 包含一个错误。例如。 - Range("D4") 可能是 #DIV/0 或 #Value

有 3 种方法来解决它（2 简单，1 困难）：

在Private Sub CommandButton1_Click() 之后写On Error Resume Next - 这确实不可取，因为它会忽略每个错误。但它会解决它。
重写整个代码，避免Select和ActiveCell（这是困难的）。 How to avoid using Select in Excel VBA
像这样写一些检查：

ActiveCell.Offset(0, 1).Select
If Not IsError(ActiveCell) Then ActiveCell.Value = DateRet

【讨论】：

你能不能写出这实在是不可取，如果可能的话，用红色、下划线、斜体和闪烁的 48 点粗体字。 :)

【解决方案2】：

这是您的代码的重构版本，应该可以满足您的需求。请注意，代码（包括您的原始版本）似乎假定“TransReq”表中只有一行（第 4 行）可以移动到“TransReqLog”表：

Private Sub CommandButton1_Click()

    Dim wb As Workbook
    Dim wsData As Worksheet
    Dim wsLog As Worksheet
    Dim rData As Range

    Set wb = ActiveWorkbook
    Set wsData = wb.Sheets("TransReq")
    Set wsLog = wb.Sheets("TransReqLog")
    Set rData = wsData.Range("B4:N4")

    wsLog.Cells(wsLog.Rows.Count, "B").End(xlUp).Offset(1).Resize(, rData.Columns.Count).Value = rData.Value
    rData.ClearContents

End Sub

请注意，请熟悉How to avoid using Select in Excel VBA（Vityata 在他的回答中也有链接）

【讨论】：

【解决方案3】：

由于这一行，您的代码仅适用于两行：
Worksheets("TransReqLog").Range("B3").End(xlDown).Select

第一行复制成功，因为IF语句导致该行代码没有执行。

第二行是成功的，因为代码选择了单元格C3，然后执行与键盘快捷键Ctrl+Down 相同的操作，后者选择了下一个不为空的单元格。然后代码偏移一行。

它在第三次尝试时中断，因为代码完全与第二次尝试相同 - 它从空的 C3 开始并向下移动到第一个非空单元格。

如果下面的所有单元格都是空的，最好从工作表底部开始向上移动到第一个不为空的单元格。
Worksheets("TransReqLog").Cells(Worksheets("TransReqLog").Rows.Count, 2).End(xlUp).Select

如果没有 XL2003 和 XL2007 或更高版本的混合，那么您可以使用Worksheets("TransReqLog").Cells(Rows.Count, 2).End(xlUp).Select

说了这么多，@tigeravatar 回答的重构就是要走的路。

【讨论】：