VBA/Excel Ошибка с Find: переменная объекта не установлена ​​или несоответствие типов

Question

В этом макросе я извлекаю сетевые данные из 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

Ошибка в 'Set 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, и диапазон, который нужно искать, всегда содержит строки.

Это очень неприятно, поэтому любая помощь будет принята с благодарностью. Заранее спасибо.

Answer 1

Попробуйте что-то вроде этого. (Непроверенные)

'
'~~> 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
'