Question

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

@BranislavKollár

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

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

这是在UserForm中吗？

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 workbook example

这是代码，

    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

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

3 个答案: