宏可以使用一张,但不能使用多张

时间:2012-08-22 20:45:09

标签: excel vba excel-vba

我正在创建一个宏,它将搜索列表并查找第一个包含“spectraseven”的列中的所有条目。这将是将这些记录复制到每个条目的工作表中。

当工作簿中只有一个工作表时,此宏工作,但是当有更多工作表时,它会在最后一行带箭头的行上给出错误object or variable with block not set。 (If FoundCell.Address = FirstAddr Then

Function mySheetData(SheetName As String) As Boolean

'
'By Joe Was
    'This adds a sheet and names it "Test."
    'SheetName = Sheets(1).Range("a1")
    Sheets.Add.Name = SheetName

    'This selects your new sheet and moves it after sheet "Sheet3," which could be any sheet name.
    Sheets(SheetName).Select
    Sheets(SheetName).Move After:=Sheets(Worksheets.Count)

    'this selects the sheet with the data and its range.
    Sheets(1).Select
    Range("A1:c20").Select

    'This will copy and paste the data to your new sheet "Test."
    Selection.Copy
    Sheets(SheetName).Select
    ActiveSheet.Paste

    'At this point your data will be on the new sheet and selected for the next step.

End Function
'copy from template sheet
'add information from each summary sheet to the tech sheets

'Function MoveToTables(manName As String, startCell As Integer, cellRange As String) As Boolean
Sub testWild()
startCell = 1
Dim FoundCell As Range
Dim LastCell As Range
Dim FirstAddr As String
Dim technum As String

cellRange = "e1:e500"
topCount = startCell
With Range("e1:e500")
    Set LastCell = .Cells(.Cells.Count)
End With
Dim findString As String
findString = "SPECTRASEVEN*"
Set FoundCell = Sheets(1).Range(cellRange).Find(what:=findString, After:=LastCell)

If Not FoundCell Is Nothing Then
    FirstAddr = FoundCell.Address
End If
Do Until FoundCell Is Nothing
    Debug.Print FoundCell.Address
    Count = FoundCell.Row
    technum = Right(FoundCell, 4)
    Set FoundCell = Range(cellRange).FindNext(After:=FoundCell)
    temp = mySheetData(technum)
    ' vv This is the line with the error vv
    If FoundCell.Address = FirstAddr Then
             Exit Do
    End If
Loop
End Sub

1 个答案:

答案 0 :(得分:0)

问题是,在Nothing的测试有可能发生之前,您正在前进到下一个单元格。

此示例用于打印单位数字:

Sub test1()

Dim j

j = 1
Do Until j = 10
    Debug.Print j
    j = j + 1
    If j = 10 Then Debug.Print "oops, why no exit?"
    Debug.Print j
Loop

End Sub

如果你运行这段代码,你会看到当j = 10时打印的消息,即使看起来循环应该结束了。
修正增量发生在循环结束,所以测试可以工作,给出:

Sub test2()

Dim j

j = 1

j = j + 1
Do Until j = 10
    Debug.Print j
    If j = 10 Then Debug.Print "oops, why no exit?"
    Debug.Print j
    j = j + 1
Loop

End Sub

请注意,我现在有2个增量,一个在循环开始之前(以防j在我开始测试之前恰好是9)和一个在结束时,所以循环可以在正确的点测试