Fatal编程技术网
  • vba/
  • Vba 设置范围时发生未知运行时错误

Vba 设置范围时发生未知运行时错误

vba excel vbscript

Vba 设置范围时发生未知运行时错误,vba,excel,vbscript,Vba,Excel,Vbscript,这是一个较大程序的子程序（如果需要，我可以复制并粘贴整个程序）。我得到了一个未知的运行时错误，我一辈子都不知道为什么。我花了几个小时感到沮丧，决定向你们寻求帮助 快速编辑：我试图找到一个特定的列标题，然后选择整个列（减去标题）作为范围 Sub YearSmash(MyString) With objSheetSrc Set FoundCell = .Range("A1:BZ1").Find(MyString, , , 1) If FoundCell Is

这是一个较大程序的子程序（如果需要，我可以复制并粘贴整个程序）。我得到了一个未知的运行时错误，我一辈子都不知道为什么。我花了几个小时感到沮丧，决定向你们寻求帮助

快速编辑：我试图找到一个特定的列标题，然后选择整个列（减去标题）作为范围

Sub YearSmash(MyString)
    With objSheetSrc
        Set FoundCell = .Range("A1:BZ1").Find(MyString, , , 1)
        If FoundCell Is Nothing Then
            Exit Sub
        End If

        MsgBox(FoundCell)

        Set rng1 = .Range(FoundCell.Offset(1), FoundCell.Offset(1).End(xlDown))

        MsgBox(rng1)
    End With
End Sub
以下行出现错误：

Set rng1 = .Range(FoundCell.Offset(1), FoundCell.Offset(1).End(xlDown))
有什么想法吗？此外，我试图提取的数据中没有无效值、错误或空值

谢谢

安德鲁

编辑以显示完整的代码：

Const xlFilterCopy = 2
strPathSrc = "C:\test" ' Source files folder
strMaskSrc = "*.xlsx" ' Source files filter mask

dtmDate = Date
strMonth = Month(Date)
strDay = Day(Date)
strYear = Right(Year(Date), 2)
strFileName = "C:\test\Results\" & strMonth & "-" & StrDay & "-" & strYear & " Results.xlsx"
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False

Set objWorkbook = objExcel.Workbooks.Add()
objWorkbook.SaveAs(strFileName)
objExcel.Quit

'strPathDst = "C:\test\Results\Results.xlsx" ' Destination file
strPathDst = strFileName

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False
Set objWorkBookDst = objExcel.Workbooks.Open(strPathDst)
Set objShellApp = CreateObject("Shell.Application")
Set objFolder = objShellApp.NameSpace(strPathSrc)
Set objItems = objFolder.Items()
objItems.Filter 64 + 128, strMaskSrc
objExcel.DisplayAlerts = False
x = 1
y = 1
MsgBox("Working")
For Each objItem In objItems
    Set objWorkBookSrc = objExcel.Workbooks.Open(objItem.Path)
    Set objSheetSrc = objWorkBookSrc.Sheets(1)
    Set objSheetDst = objWorkBookDst.Sheets(1)
    For Each Cell In objSheetSrc.Range("A1:Z15")
        If Cell.MergeCells = True Then
            Set objRange = Cell.EntireRow
            objRange.Delete
        End If
    Next

    'Set FoundCell = objSheetSrc.Range("A1:BZ1").Find("Device", , , 1)

    'For Each Cell In objSheetSrc.Range(FoundCell.Offset(1,0), objSheetSrc.Cells(objSheetSrc.Rows.Count, FoundCell.Column).End(-4162)).Cells
        'If Cell.Value <> "*MSP430*" Then
        '   Cell.EntireRow.Delete
        'End If
    'Next

    Set objSheetDst = objWorkBookDst.Sheets(1)

    Call FindCell("Sales Region")
    Call FindCell("Sales Area")
    Call FindCell("TSR Role")
    Call FindCell("My Account")
    Call FindCell("Account Class")
    Call FindCell("Project Name")
    Call FindCell("Device")
    Call FindCell("AUP")
    Call FindCell("Qty Per Board")
    Call FindCell("Device Status")
    Call FindCell("Project Status")
    Call FindCell("Project Kickoff")
    Call FindCell("Market")
    Call FindCell("SBE")
    Call FindCell("SBE-1")
    Call FindCell("SBE-2")
    Call FindCell("2013 Q1")
    Call FindCell("2013 Q2")
    Call FindCell("2013 Q3")
    Call FindCell("2013 Q4")
    Call FindCell("2014 Q1")
    Call FindCell("2014 Q2")
    Call FindCell("2014 Q3")
    Call FindCell("2014 Q4")
    Call FindCell("2015 Q1")
    Call FindCell("2015 Q2")
    Call FindCell("2015 Q3")
    Call FindCell("2015 Q4")
    Call FindCell("2016")
    Call YearSmash("2016 Q1")
    Call FindCell("2016 Q1")
    Call FindCell("2017")
    Call FindCell("2018")

    objWorkBookSrc.Close
Next

objExcel.Visible = True

Sub FindCell(MyString)
    Do While objSheetDst.Cells(x, y).Value <> ""
        y = y + 1
    Loop

    If MyString = "Sales Region" And y > 2 Then
        y = 1
        Do While objSheetDst.Cells(x, y).Value <> ""
            x = x + 1
        Loop
    End If

    Set FoundCell = objSheetSrc.Range("A1:BZ1").Find(MyString, , , 1)
    If FoundCell Is Nothing Then
        Exit Sub
    End If

    Set objRangeSrc = FoundCell.EntireColumn
    objRangeSrc.AdvancedFilter xlFilterCopy, , objSheetDst.Cells(x, y), False
End Sub

Sub YearSmash(MyString)
    With objSheetSrc
        Set FoundCell = .Range("A1:BZ1").Find(MyString, , , 1)
        If FoundCell Is Nothing Then Exit Sub

        Set lRow = .Cells(.Rows.Count, FoundCell.Column).End(xlUp).Row

        Set rng1 = .Range(.Cells(FoundCell.Row + 1, FoundCell.Column), .Cells(lRow, FoundCell.Column))

        MsgBox rng1.Address
    End With
End Sub

Const xlFilterCopy=2
strPathSrc=“C:\test”'源文件文件夹
strMaskSrc=“*.xlsx””源文件筛选器掩码
dtmDate=日期
strMonth=月（日）
标准日=天（日期）
strYear=右侧（年份（日期），2）
strFileName=“C:\test\Results\”&strMonth&“-”&StrDay&“-”&strYear&“Results.xlsx”
设置objExcel=CreateObject（“Excel.Application”）
objExcel.Visible=False
设置objWorkbook=objExcel.Workbooks.Add（）
objWorkbook.SaveAs（strFileName）
退出
'strPathDst=“C:\test\Results\Results.xlsx”'目标文件
strPathDst=strFileName
设置objExcel=CreateObject（“Excel.Application”）
objExcel.Visible=False
设置objWorkBookDst=objExcel.Workbooks.Open（strPathDst）
设置objShellApp=CreateObject（“Shell.Application”）
设置objFolder=objShellApp.NameSpace（strPathSrc）
设置objItems=objFolder.Items（）
objItems.Filter 64+128，strMaskSrc
objExcel.DisplayAlerts=False
x=1
y=1
MsgBox（“工作”）
对于objItems中的每个objItem
设置objWorkBookSrc=objExcel.Workbooks.Open（objItem.Path）
设置objSheetSrc=objWorkBookSrc.Sheets（1）
设置objSheetDst=objWorkBookDst.Sheets（1）
对于objSheetSrc.范围（“A1:Z15”）中的每个单元格
如果Cell.MergeCells=True，则
设置objRange=Cell.EntireRow
objRange.Delete
如果结束
下一个
'Set FoundCell=objSheetSrc.Range（“A1:BZ1”）.Find（“设备”，.1）
'对于objSheetSrc.Range（FoundCell.Offset（1,0）、objSheetSrc.Cells（objSheetSrc.Rows.Count、FoundCell.Column.End（-4162））.Cells中的每个单元格
'如果Cell.Value“*MSP430*”则
'Cell.EntireRow.Delete
"完"
”“接着呢
设置objSheetDst=objWorkBookDst.Sheets（1）
致电FindCell（“销售区域”）
致电FindCell（“销售区域”）
呼叫FindCell（“TSR角色”）
致电FindCell（“我的账户”）
调用FindCell（“帐户类”）
调用FindCell（“项目名称”）
呼叫FindCell（“设备”）
呼叫FindCell（“AUP”）
调用FindCell（“每个板的数量”）
呼叫FindCell（“设备状态”）
呼叫FindCell（“项目状态”）
呼叫FindCell（“项目启动”）
呼叫FindCell（“市场”）
呼叫FindCell（“SBE”）
呼叫FindCell（“SBE-1”）
呼叫FindCell（“SBE-2”）
呼叫FindCell（“2013年第一季度”）
致电FindCell（“2013年第二季度”）
致电FindCell（“2013年第三季度”）
呼叫FindCell（“2013年第4季度”）
致电FindCell（“2014年第一季度”）
致电FindCell（“2014年第二季度”）
致电FindCell（“2014年第三季度”）
致电FindCell（“2014年第四季度”）
呼叫FindCell（“2015年第一季度”）
致电FindCell（“2015年第二季度”）
致电FindCell（“2015年第三季度”）
致电FindCell（“2015年第四季度”）
呼叫FindCell（“2016”）
电话年审（“2016年第一季度”）
致电FindCell（“2016年第一季度”）
呼叫FindCell（“2017”）
呼叫FindCell（“2018”）
objWorkBookSrc.关闭
下一个
objExcel.Visible=True
子FindCell（MyString）
Do While objSheetDst.Cells（x，y）.Value“”
y=y+1
环
如果MyString=“Sales Region”和y>2，则
y=1
Do While objSheetDst.Cells（x，y）.Value“”
x=x+1
环
如果结束
Set FoundCell=objSheetSrc.Range（“A1:BZ1”）.Find（MyString，，1）
如果FoundCell什么都不是
出口接头
如果结束
设置objRangeSrc=FoundCell.EntireColumn
objRangeSrc.AdvancedFilter xlFilterCopy，objSheetDst.Cells（x，y），False
端接头
次年扣杀（MyString）
使用objSheetSrc
Set FoundCell=.Range（“A1:BZ1”）.Find（MyString，，1）
如果FoundCell为Nothing，则退出Sub
设置lRow=.Cells（.Rows.Count，FoundCell.Column）.End（xlUp）.Row
设置rng1=.Range（.Cells（FoundCell.Row+1，FoundCell.Column），.Cells（lRow，FoundCell.Column））
MsgBox rng1.地址
以
端接头
这就是您要尝试的吗

Sub YearSmash(MyString)
    Dim objSheetSrc As Worksheet
    Dim lRow As Long
    Dim FoundCell As Range, rng1 As Range
    Dim MyString As String

    '~~> Change as applicable
    Set objSheetSrc = ThisWorkbook.Sheets("Sheet1")

    With objSheetSrc
        Set FoundCell = .Range("A1:BZ1").Find(MyString, , , 1)

        If FoundCell Is Nothing Then Exit Sub

        '~~> Find the last row in that column
        lRow = .Cells(.Rows.Count, FoundCell.Column).End(xlUp).Row

        '~~> Construct your range from one cell offset
        Set rng1 = .Range(.Cells(FoundCell.Row + 1, FoundCell.Column), _
                          .Cells(lRow, FoundCell.Column))

        MsgBox rng1.Address
    End With
End Sub
评论的后续行动

我在vbscript中测试了它，它工作得非常好

Dim oXLApp, olXLWb, objSheetSrc
Dim MyString, lRow, FoundCell, rng1

Set oXLApp = CreateObject("Excel.Application")

oXLApp.Visible = True

'~~> Sample File
Set olXLWb = oXLApp.Workbooks.Open("C:\Sample.xlsx")

'~~> Change as applicable
Set objSheetSrc = olXLWb.Sheets("Sheet1")

'~~> Sample String
MyString = "Sid"

With objSheetSrc
    Set FoundCell = .Range("A1:BZ1").Find(MyString, , , 1)

    If Not FoundCell Is Nothing Then
        '~~> Find the last row in that column
        lRow = .Cells(.Rows.Count, FoundCell.Column).End(-4162).Row

        '~~> Construct your range from one cell offset
        Set rng1 = .Range(.Cells(FoundCell.Row + 1, FoundCell.Column), _
                          .Cells(lRow, FoundCell.Column))

        MsgBox rng1.Address
    End If
End With
悉达思，感谢你的迅速回复。从你的代码来看，这看起来就像我要做的。。。不幸的是，它仍然向我抛出一个未知的运行时错误。lRow=.Cells（.Rows.Count，FoundCell.Column）。End（xlUp）。Row给出了错误。就像我说的，这个子程序是作为一个更大的子程序的一部分调用的，如果你需要我发布完整的代码，请告诉我！是的，这会有帮助，因为该行不应给出错误，因为对象是完全合格的。您是在VBSCRIPT中执行此操作的吗？如果是，则将行
lRow=.Cells（.Rows.Count，FoundCell.Column）.End（xlUp）.Row
更改为
lRow=.Cells（.Rows.Count，FoundCell.Column）.End（-4162）。Row
是Excel常量。这修复了未知错误问题。现在我遇到了另一个我以前遇到过的类似问题。同一行现在给出了错误“objectrequired”。我记得早些时候，当我试图使用.Row或.Column时，我收到了这些错误。