0

在这个宏中,我从 Visio 中提取网络数据并将其放入 excel 文件中。在 visio 文件中,有些对象可能会出现多次,但我只希望这些项目在 excel 文件中列出一次。因此,在输入新条目之前,宏首先搜索先前记录的数据范围。错误出现在 .Find 命令中。令人沮丧的是,宏将运行一次,然后在后续运行时失败。但如果我重置它,它会再次运行。我实际上尝试了两种略有不同的搜索方式。第一种方法导致“未设置块变量的对象变量”错误。第二种方法导致“类型不匹配”错误。这是代码的相关部分(带有**的错误部分)

Dim oXLApp As Excel.Application
Dim oXLBook As Excel.Workbook
Dim oXLSheet As Excel.Worksheet
Set oXLApp = New Excel.Application    'Create a new instance of Excel
oXLApp.Visible = True
Dim iSheetsPerBook As Integer         'Add a new workbook (with one sheet)
iSheetsPerBook = oXLApp.SheetsInNewWorkbook
oXLApp.SheetsInNewWorkbook = 4
Set oXLBook = oXLApp.Workbooks.Add
oXLApp.SheetsInNewWorkbook = iSheetsPerBook
Set oXLSheet = oXLBook.Worksheets(1) 
Dim CurrentTrans As String
Dim RangeObj As Range

Application.ActiveWindow.SelectAll
Dim RowCounter As Integer
Dim ColCounter As Integer
Dim NeededSpaces As Integer
RowCounter = 1

For x = 1 To ActiveWindow.Selection.Count 'iterate all selected shapes
    Dim vsoshape As Visio.shape
    Dim vsoShapetype As String
    Set vsoshape = ActiveWindow.Selection(x) 'activate next selected shape

    If Not vsoshape Is Nothing Then
        If InStr(vsoshape.Name, "Circle") > 0 Then
          Dim lngOutGoingShapeIDs() As Long
          Dim lngIncomingShapeIDs() As Long
          lngOutGoingShapeIDs = vsoshape.ConnectedShapes(visConnectedShapesOutgoingNodes, "")
          lngIncomingShapeIDs = vsoshape.ConnectedShapes(visConnectedShapesIncomingNodes, "")

          Dim NewTrans As Integer  'Flag to show if Transition is new (=1) or was previously listed (=0)
          NewTrans = 1             ' Reset flag to 1, assumes transition is new
          ColCounter = 2                ' Reset ColCounter to 2

          If Not IsEmpty(oXLSheet.Cells(1, 1).Value) Then  'Previous Firing Data Exists, Must check listed transitions to avoid duplication
            oXLSheet.Range("A1", oXLSheet.Range("A1").End(xlDown)).Select
            CurrentTrans = vsoshape.Text
            Debug.Print CurrentTrans
            **Set RangeObj = Selection.Find(What:=CurrentTrans, After:=ActiveCell, LookIn:=xlFormulas, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)**
            If RangeObj Is Nothing Then   'This is a new tranisition with no previous Firing data listed
                oXLSheet.Range("A1").End(xlDown).Activate
                RowCounter = ActiveCell.Row + 1

错误在“设置 RangeObj ...”中。在这种情况下,宏将成功运行一次。但随后的尝试给出了“未设置块变量的对象变量”错误。如果 vba 被重置,它将再次运行。如果我改为按如下方式设置 RangeObj,则会收到“运行时错误 13 类型不匹配”。

   Set RangeObj = oXLSheet.Range("A1", oXLSheet.Range("A1").End(xlDown)).Find(What:=CurrentTrans, After:=ActiveCell, LookIn:=xlFormulas, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)

与上一个问题一样,这将运行一次,然后在此步骤中失败并出现错误,直到宏被重置。我检查了我正在搜索的“CurrentTrans”变量,它始终是一个字符串。我将其设置为查看 excel 工作表,并且要搜索的范围始终包含字符串。

这非常令人沮丧,因此将不胜感激任何帮助。提前致谢。

4

1 回答 1

0

尝试这样的事情。(未经测试)

'
'~~> Rest of the code
'

Dim Lrow As Long
Dim rngF As Range

With oXLSheet
    Lrow = .Range("A" & .Rows.Count).End(xlUp).Row

    Set rngF = .Range("A1:A" & Lrow)
End With

CurrentTrans = vsoshape.Text

Set RangeObj = rngF.Find(What:=CurrentTrans, LookIn:=xlFormulas, _
                    LookAt:=xlWhole, SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False)

'
'~~> Rest of the code
'
于 2013-04-29T20:24:05.313 回答