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

我是VBA的新手，想编写一些生成报告的代码

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

我想做的是在工作表中进行第一次搜索，并将日期与找到的日期进行比较，以获取所有数据并显示在工作表名称报告中。 然后转到下一张可用于搜索同一日期的工作表，并在报告中显示

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

这是用户表单吗

ws1 = "Report"

应该是

set ws1=sheets("Report")

---

修改代码如下：

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

---

---

---

希望这有帮助。

我已经制作了一个示例工作簿，请单击链接打开它

这是代码

    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

Private子命令按钮1\u单击（）
将ws标注为工作表，sh标注为工作表，s标注为字符串
变暗行长度，rng为范围，c为范围
设置ws=工作表（“报告”）
对于每一张图纸
如果sh.Name ws.Name那么
与sh
Rws=.Cells（.rows.Count，“A”）.End（xlUp）.Row'查找sh中的最后一行
Set rng=.Range（.Cells（1，1），.Cells（Rws，1））'将范围设置为循环
s=报告日期
对于rng.Cell的开始循环中的每个c
如果c.值=s，则
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”））。复制
ws.Cells（lstrow+1,3）.paste特殊xlpaste值
如果结束
下一个c
以
如果结束
下一个sh
卸下我
端接头

与您的代码一样，仍然是提供给我错误运行时错误“424”；对象是必需的。数字=数字+1表示报告表行的数字示例：报告表1 xxx xxx xxx xxx 2 xxx xxx xxx xxx 1和2是数字。@chiafttan哪一行给出了错误？我在代码中重新排列了计数器行的顺序，因为您确认要使用它。~顶部检查~我已编辑了我的问题：）~感谢您帮助我逐步检查代码（使用F8），并验证

If Not FoundCell Is Nothing

是否为

True

（换句话说，If语句中的行已被计算）。还有一件事。请使用此行

FindDate=Range（“reportDate”）。Value

而不是

FindDate=reportDate。Value

@Branislav尝试了FindDate=Range（“reportDate”）。Value但出现错误运行时错误“1004”对象“\u Global”的方法“Range”失败。关于F8，我不确定如何验证>。关于错误：我以为您的工作簿中有“reportDate”作为命名范围。如果没有，请这样做，否则您可以使用单元格引用，即：

FindDate=Range（“A5”）。值

，当然可以将其更改为日期所在的单元格。关于F8：在Visual Basic环境中，单击

Sub

和

End Sub

之间的任意位置，然后按F8键，只要您一直按F8键，它将一行一行地运行代码。您还可以在“视图>工具栏>调试>单步执行”中的按钮中找到它。reportDate是工具箱中日历中的一个值。同样对于F8，已经显示出这些步骤正在工作。只是没有显示任何数据…@@…感谢您花时间编写工作簿示例，但当我尝试使用您提供的工作簿时，仍然无法生成任何详细信息，即使使用您提供的工作簿示例，也只能生成“标题1”，其他日期无法生成，即使其中有数据。请将我们链接到一个示例。我已使用您提供的示例解决了所有问题，非常感谢，但我遇到了另一个问题，如果在同一张表中，我有两个相同日期但不同的数据，如何在报告中显示2，而不是仅显示vba发现的第一个如果原始问题已解决，请将其标记为答案。我将很快为您编辑代码。代码已更改为在每张工作表的A列中循环查找所选日期。

    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