Question

最近，我一直致力于开发一个电子表格，允许用户在发票模板页面上输入数据，然后将该信息保存在另一张表格中。发票模板如下所示：

我只为每个细胞输入随机输入。然后，当用户按下“保存”论坛按钮时，需要将来自B17：H37的数据移动到名为发票数据的工作表中。数据应该在Invoice数据页面上输入D：G，但结果是这样的：

A：C在B17：H37之外填入不同的值（如下面的代码所示），但只将发票框中的“名称”数据（B列）复制到发票数据表，而“小时”，“成本”和“总计”被忽略。这是我到目前为止的代码（来自我在网上找到的教程）：

Sub save_invoice()
  Dim rng As Range
  Dim i As Long
  Dim a As Long
  Dim rng_dest As Range
  Application.ScreenUpdating = False
  'Check if invoice # is found on sheet "Invoice data"
  i = 1
  Do Until Sheets("Invoice data").Range("A" & i).Value = ""
    If Sheets("Invoice data").Range("A" & i).Value = Sheets("Invoice").Range("E7") & "-" & Range("F7").Value Then
      'Ask overwrite invoice #?
      If MsgBox("Overwrite invoice data?", vbYesNo) = vbNo Then
        Exit Sub
      Else
        Exit Do
      End If
    End If
    i = i + 1
  Loop
  i = 1
  Set rng_dest = Sheets("Invoice data").Range("D:F")
  'Delete rows if invoice # is found
  Do Until Sheets("Invoice data").Range("A" & i).Value = ""
    If Sheets("Invoice data").Range("A" & i).Value = Sheets("Invoice").Range("E7") & "-" & Range("F7").Value Then
      Sheets("Invoice data").Range("A" & i).EntireRow.Delete
      i = 1
    End If
    i = i + 1
  Loop
  ' Find first empty row in columns D:G on sheet Invoice data
  Do Until WorksheetFunction.CountA(rng_dest.Rows(i)) = 0
    i = i + 1
  Loop
  'Copy range B17:F37 on sheet Invoice
  Set rng = Sheets("Invoice").Range("B17:H37")
  ' Copy rows containing values to sheet Invoice data
 For a = 1 To rng.Rows.Count
    If WorksheetFunction.CountA(rng.Rows(a)) <> 0 Then
      rng_dest.Rows(i).Value = rng.Rows(a).Value
      'Copy Invoice number
      Sheets("Invoice data").Range("A" & i).Value = Sheets("Invoice").Range("E7") & "-" & Range("F7").Value
      'Copy Date
      Sheets("Invoice data").Range("B" & i).Value = Sheets("Invoice").Range("B2").Value
      'Copy Project Name
      Sheets("Invoice data").Range("C" & i).Value = Sheets("Invoice").Range("C7").Value
      i = i + 1
    End If
  Next a
  Application.ScreenUpdating = True
End Sub

我对VBA还很新，所以我完全糊涂了。我尝试了调试功能，这是代码通常搞砸的地方：For a = 1 To rng.Rows.Count If WorksheetFunction.CountA(rng.Rows(a)) <> 0 Then rng_dest.Rows(i).Value = rng.Rows(a).Value。如果你能帮助我解决这个问题，我将非常感激：）

另外，作为旁注，是否有办法使“总计”（H列）中的“0”的行不会转移到发票数据页面？感谢您的时间。

在这张图片中，我希望删除第7行及以下的所有内容，因为我没有在发票页面中为这些行输入任何内容。

Answer 1

我修改了结果循环，如下所示：

'Copy rows containing values to sheet Invoice data
For a = 17 To 37

    If WorksheetFunction.CountA(Sheets("Invoice").Range("B" & a & ":H" & a)) <> 0 Then

        'Copy Invoice number
        Sheets("Invoice data").Range("A" & i) = Sheets("Invoice").Range("E7") & "-" & Sheets("Invoice").Range("F7")

        'Copy Date
        Sheets("Invoice data").Range("B" & i) = Sheets("Invoice").Range("B2")

        'Copy Project Name
        Sheets("Invoice data").Range("C" & i) = Sheets("Invoice").Range("C7")

        'Copy Name
        Sheets("Invoice data").Range("D" & i) = Sheets("Invoice").Range("B" & a)

        'Copy Hours
        Sheets("Invoice data").Range("E" & i) = Sheets("Invoice").Range("F" & a)

        'Copy Cost
        Sheets("Invoice data").Range("F" & i) = Sheets("Invoice").Range("G" & a)

        'Copy Total
        Sheets("Invoice data").Range("G" & i) = Sheets("Invoice").Range("H" & a)

        'increase invoice data row
        i = i + 1

    End If

Next a

我已经使用您的输入数据测试了代码。它对我很有用。试试这个。

<强>加了：

如果您想添加新条件，请修改 if 语句，如下所示：

If WorksheetFunction.CountA(Sheets("Invoice").Range("B" & a & ":G" & a)) <> 0  And Sheets("Invoice").Range("H" & a) > 0 Then

Excel无法将数据从一张纸正确传输到另一张纸

1 个答案: