Question

我对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

Answer 1

＆＃34;数据在两个条目后停止复制。＆＃34; - 这意味着它会在此处停止 - IntStream.range(0, 2).boxed() .flatMap(x -> Stream.of("a", "b", "c")) .forEach(System.out::println);可能的原因应该是ActiveCell.Value = POCPhone包含错误。例如。 - POCPhone可能是Range("D4")或#DIV/0

有3种方法可以修复它（2个容易，1个难点）：

在#Value之后写On Error Resume Next - 这实际上是不可取的，因为它会忽略每个错误。但它会修复它。
重写整个代码，避免使用Private Sub CommandButton1_Click()和Select（这很难）。 How to avoid using Select in Excel VBA
写一些像这样的支票：

ActiveCell

Answer 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在答案中也链接到此处）

Answer 3

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

第一行被成功复制，因为IF语句未执行代码行。

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

它在第三次尝试时中断，因为代码完全与第二次尝试相同 - 它从空Worksheets("TransReqLog").Cells(Worksheets("TransReqLog").Rows.Count, 2).End(xlUp).Select开始并向下移动到第一个不为空的单元格。 / p>

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

如果没有XL2003和XL2007或更高版本的混合物，那么您可以使用const router = new VueRouter({ routes: [ { path: '/foo', name:"Foo" component: Foo, props: (route) => ({ query: route.query.q }) } ] }) OR {path:'/foo/:booleanParam', name:'Foo', component: Foo }

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

Excel VBA宏代码中的未知错误

3 个答案: