首页
学习
活动
专区
圈层
工具
发布
首页
学习
活动
专区
圈层
工具
MCP广场
社区首页 >问答首页 >编译错误:循环遍历工作表时限定符无效

编译错误:循环遍历工作表时限定符无效
EN

Stack Overflow用户
提问于 2018-06-04 20:49:22
回答 1查看 268关注 0票数 0

我正在尝试将多个工作表中的单元格复制到摘要工作表中,前提是它们的日期(以列形式保存。G)落在给定范围内。我希望宏循环遍历每个工作表中的列g,并在进入下一个工作表执行相同操作之前,将匹配的信息放入其中。目前,我的代码显示一个编译错误:rng中的x值的限定符无效...我是VBA新手,看不到我做错了什么。

代码语言:javascript
运行
复制
Sub Copy_ProjectSummaryData()
Dim i As Integer
Dim ws_num As Integer
Dim rng As Range, destRow As Long
Dim starting_ws As Worksheet
Dim shtDest As Worksheet
Dim c As Range
Dim startdate As Date
Dim enddate As Date
Set starting_ws = ThisWorkbook.Worksheets(1) 'remember which worksheet is 
active in the beginning
ws_num = ThisWorkbook.Worksheets.Count
Set shtDest = Sheets("Summary")

destRow = 4 'start copying to this row
destRow2 = 4 'start copying to this row
destRow3 = 4 'start copying to this row
destRow4 = 4 'start copying to this row
startdate = CDate(InputBox("Begining Date"))
enddate = CDate(InputBox("End Date"))

'Clear contents from sheet before running new report
Range("A4").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents

'Find and pull in Escalated Risks within the date range for the report
For i = 1 To ws_num
ThisWorkbook.Worksheets(i).Activate
        Set rng = 
Application.Intersect(ThisWorkbook.Worksheets(i).Range("G16:G20"), 
ThisWorkbook.Worksheets(i).UsedRange)
    For Each c In rng.Cells
         If c.Value >= startdate And c.Value <= enddate Then
        'Starting 6 cells to the left of c (col A),
        '  copy an 8-cell wide block to the other sheet,
        '  pasting it in Col B on row destRow
        c.Offset(0, -6).Resize(1, 8).Copy _
        shtDest.Cells(destRow, 2)
        destRow = destRow + 1
      End If
      Next
Next

'Find and paste Risk Project Name
For i = 1 To ws_num

ThisWorkbook.Worksheets(i).Activate

Set rng = Application.Intersect(ThisWorkbook.Worksheets(i).Range("G16:G20"), 
ThisWorkbook.Worksheets(i).UsedRange)
For Each c In rng.Cells
    If c.Value >= startdate And c.Value <= enddate Then
    '  copy C3 to the other sheet,
    '  pasting it in Col A on row destRow
    Range("C3").Copy _
    shtDest.Cells(destRow2, 1)
    destRow2 = destRow2 + 1
    End If
Next
Next

'Find and pull in New Issues within the date range for the report
For i = 1 To ws_num
ThisWorkbook.Worksheets(i).Activate

    Set rng = 
Application.Intersect(ThisWorkbook.Worksheets(i).Range("G22:G26"), 
ThisWorkbook.Worksheets(i).UsedRange)
    For Each c In rng.Cells
         If c.Value >= startdate And c.Value <= enddate Then
        'Starting 6 cells to the left of c (col A),
        '  copy an 8-cell wide block to the other sheet,
        '  pasting it in Col B on row destRow
        c.Offset(0, -6).Resize(1, 8).Copy _
        shtDest.Cells(destRow3, 11)
        destRow3 = destRow3 + 1
      End If
      Next
 Next
'Find and paste Issues Project Name
For i = 1 To ws_num

ThisWorkbook.Worksheets(i).Activate
    Set rng = 
Application.Intersect(ThisWorkbook.Worksheets(i).Range("G22:G26"), 
ThisWorkbook.Worksheets(i).UsedRange)
For Each c In rng.Cells
    If c.Value >= startdate And c.Value <= enddate Then
    '  copy C3 to the other sheet,
    '  pasting it in Col A on row destRow
    Range("C3").Copy _
    shtDest.Cells(destRow4, 10)
    destRow4 = destRow4 + 1
    End If
Next
Next

starting_ws.Activate 'activate the worksheet that was originally active

Range("B4").Select
Selection.Copy
Range("A4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Range("K4").Select
Selection.Copy
Range("J4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

End Sub
EN

回答 1

Stack Overflow用户

发布于 2018-06-04 20:59:16

您已将X声明为LongLong没有范围。您应该使用Sheets(X),而不仅仅是X

代码语言:javascript
运行
复制
Set rng = Application.Intersect(Sheets(x).Range("G:G"), Sheets(x).UsedRange)
票数 0
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/50681044

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档