（Excel VBA）报告问题生成代码

Question

我对VBA完全陌生，想做一些代码来生成报告。

下面的代码是我尝试做的自己，但未能生成我想要的只是显示编译错误：无效的限定符。

我想做的是第一次在工作表中搜索并比较日期，而不是找到所有数据并以工作表名称“ Report”显示。 比转到下一个可用于搜索相同日期的表，然后还要在“报告”上显示。

Private Sub CommandButton1_Click()

Dim ws As Worksheet
Dim ws1 As Worksheet
Dim SheetName As String
Dim FoundCell As Excel.Range
Dim iRow As Long
Dim number As Integer
Dim Row As Long

number = 0
ws1 = "Report"

For Each Sheet In test.Worksheets
SheetName = Sheet.Name

Set FoundCell = SheetName.Range("A:A").Find(what:=reportDate.Value,     lookat:=xlWhole)

If Not FoundCell Is Nothing Then
  Row = FoundCell.Row
  iRow = ws1.Cells.Find(what:="*", After:=ws.Range("b1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
  .Cells(iRow, 1).Value = number + 1
  .Cells(iRow, 2).Value = SheetName
  .Cells(iRow, 3).Value = Sheets(SheetName).Cells(Row, 2)
  .Cells(iRow, 4).Value = Sheets(SheetName).Cells(Row, 3)
  .Cells(iRow, 5).Value = Sheets(SheetName).Cells(Row, 4)
  .Cells(iRow, 6).Value = Sheets(SheetName).Cells(Row, 5)
  .Cells(iRow, 7).Value = Sheets(SheetName).Cells(Row, 6)
  .Cells(iRow, 8).Value = Sheets(SheetName).Cells(Row, 7)
  .Cells(iRow, 9).Value = Sheets(SheetName).Cells(Row, 8)
  .Cells(iRow, 10).Value = Sheets(SheetName).Cells(Row, 9)
  .Cells(iRow, 11).Value = Sheets(SheetName).Cells(Row, 10)
  .Cells(iRow, 12).Value = Sheets(SheetName).Cells(Row, 11)
  .Cells(iRow, 13).Value = Sheets(SheetName).Cells(Row, 12)
  .Cells(iRow, 14).Value = Sheets(SheetName).Cells(Row, 13)
  .Cells(iRow, 15).Value = Sheets(SheetName).Cells(Row, 14)
  .Cells(iRow, 16).Value = Sheets(SheetName).Cells(Row, 15)

Else

End If

Next Sheet


End Sub

@布拉尼斯拉夫·科拉尔

我刚刚使用了您提供的代码并对其进行了一些更改，现在出现了一个问题，其中没有错误消息，但是在报表上没有生成任何输出。

Private Sub GenerateBtn_Click()

Dim wsReport As Worksheet
Dim FoundCell As Excel.Range
Dim iRow As Long
Dim number As Long
Dim lngRow As Long 'changed, you shouldn't use keywords as variable names
Dim objEachSheet As Worksheet 'added
Dim FindDate As Date


FindDate = reportDate.Value


number = 1

Set wsReport = Sheets("Report") 'changed

For Each objEachSheet In ThisWorkbook.Worksheets 'changed variable

    Set FoundCell = objEachSheet.Range("A:A").Find(what:=FindDate, lookat:=xlWhole)     'changed sheet reference; expecting trouble here

    If Not FoundCell Is Nothing Then
        With wsReport
            lngRow = FoundCell.Row
            iRow = .Cells.Find(what:="*", After:=.Range("b1"),         SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1 'changed
            'line above can cause logical errors
            .Cells(iRow, 1).Value = number
            .Cells(iRow, 2).Value = objEachSheet.Name
            .Cells(iRow, 3).Value = objEachSheet.Cells(lngRow, 2)

    End With


    End If
number = number + 1
Next objEachSheet

End Sub

Answer 1

这是在用户窗体中吗？

ws1 = "Report"

应该

set ws1=sheets("Report")

Answer 2

修改您的代码，如下所示：

• 删除了一些不必要的变量
• 改变了一些变量
• 正确设置工作表对象
• 在适当的情况下与块语句一起使用
• 将多行合并为一个
• 添加了注释，以进一步思考和警告

---

Private Sub CommandButton1_Click() 'change the name of the button, you won't regret it in long run

Dim wsReport As Worksheet
Dim FoundCell As Excel.Range
Dim iRow As Long
Dim number As Integer
Dim lngRow As Long 'changed, you shouldn't use keywords as variable names
Dim objEachSheet As Worksheet 'added

Set wsReport = Sheets("Report") 'changed

For Each objEachSheet In ThisWorkbook.Worksheets 'changed variable

    Set FoundCell = objEachSheet.Range("A:A").Find(what:=reportDate.Value, lookat:=xlWhole) 'changed sheet reference; expecting trouble here

    If Not FoundCell Is Nothing Then
        With wsReport
            lngRow = FoundCell.Row
            iRow = .Cells.Find(what:="*", After:=.Range("b1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1 'changed
            'line above can cause logical errors
            number = number + 1
            .Cells(iRow, 1).Value = number
            .Cells(iRow, 2).Value = objEachSheet.Name
        End With

        With objEachSheet
          .Range(.Cells(lngRow, 2), .Cells(lngRow, 15)).Copy wsReport.Cells(iRow, 3)
        End With
    End If
Next objEachSheet

End Sub

---

希望这可以帮助。

Answer 3

我已经制作了一个示例工作簿，单击链接将其打开。

Chia Fatt Tan工作簿示例

这是代码，

    Private Sub CommandButton1_Click()
    Dim ws As Worksheet, sh As Worksheet, s As String
    Dim rows As Long, rng As Range, c As Range
    Set ws = Sheets("Report")
    For Each sh In Sheets
        If sh.Name <> ws.Name Then
            With sh
                Rws = .Cells(.rows.Count, "A").End(xlUp).Row'finds last row in the sh
                Set rng = .Range(.Cells(1, 1), .Cells(Rws, 1))'sets the range to loop
                s = reportDate

                For Each c In rng.Cells'start loop
                    If c.Value = s Then
                        lstrow = ws.Cells(ws.rows.Count, "A").End(xlUp).Row
                        ws.Cells(lstrow + 1, "A") = lstrow
                        ws.Cells(lstrow + 1, "B") = sh.Name

                        .Range(.Cells(c.Row, "B"), .Cells(c.Row, "P")).Copy
                        ws.Cells(lstrow + 1, 3).PasteSpecial xlPasteValues
                    End If
                Next c
            End With
        End If
    Next sh

    Unload Me
End Sub