Надстройка Fuzzy Lookup вставляет результаты в полуслучайном месте

Question

«Надстройка нечеткого поиска для Excel», для справки, доступна здесь.

Я получаю кучу "заголовков", которые постоянно меняются - как по названию (немного), так и по местоположению. Так что отправляйтесь в нечеткое совпадение земель, чтобы выяснить, где сейчас все и как они называются. Первый раз, когда я запускаю нечеткий матч, он работает! Я получаю детали, как показано на картинке. (Таблица, указанная Headers является источником, а таблица, указанная с помощью Matching содержит результаты.)

Однако, когда я запускаю его снова, результаты оказываются в правом нижнем углу, как показано на рисунке. Это почему? Как я могу предотвратить это и добиться того, чтобы данные постоянно оказывались там, где я этого хочу?

(И да, я вижу, что "Скидки" не должны совпадать с "Валовой суммой за вычетом скидок" во второй раз - они должны быть пустыми). Это можно исправить, просто поиграв с настройками.)

Answer 1

Таблица выводится, начиная с активной ячейки. Таким образом, вы должны выбрать, где вы хотите таблицу, нажав на ячейку в верхнем левом углу, прежде чем нажать "GO".

Answer 2

Вы не можете напрямую написать сценарий надстройки Fuzzy Lookup , но мне удалось обойти большинство ошибок и проблем с ней.

Следующий код "заблокирует" выходное местоположение для указанной таблицы независимо от положения активной ячейки с помощью событий Workbook_SheetChange и Workbook_SheetSelectionChange :

'============================================================================================
' Module     : ThisWorkbook
' Version    : 1.0
' Part       : 1 of 1
' References : N/A
' Source     : https://superuser.com/a/1283003/763880
'============================================================================================
Option Explicit

Private Const s_FuzzyLookupResultsTable As String = "MatchingTable"
Private Const RESTORE_SELECTION As Boolean = True

Private Sub Workbook_SheetChange _
            ( _
                       ByVal TheWorksheet As Object, _
                       ByVal Target As Range _
            )
        Dim Ä As Excel.Application: Set Ä = Excel.Application
        Dim ƒ As Excel.WorksheetFunction: Set ƒ = Excel.WorksheetFunction

  Const l_FuzzyLookup_AddIn_Undo_Sheet As String = "FuzzyLookup_AddIn_Undo_Sheet"
  Const s_InCell_Error_Message As String = "SAVE, CLOSE & REOPEN if pressing GO again doesn't fix it"

  Static swkstActiveFuzzyLookupSheet As Worksheet
  Static sstrOriginalSelection As String

  Select Case True
    Case TheWorksheet.Name <> l_FuzzyLookup_AddIn_Undo_Sheet And swkstActiveFuzzyLookupSheet Is Nothing:
      Exit Sub
    Case TheWorksheet.Name = l_FuzzyLookup_AddIn_Undo_Sheet And swkstActiveFuzzyLookupSheet Is Nothing:
      'TODO If missing table
      Set swkstActiveFuzzyLookupSheet = ActiveSheet
      sstrOriginalSelection = Selection.Address
    Case TheWorksheet.Name = l_FuzzyLookup_AddIn_Undo_Sheet And Not swkstActiveFuzzyLookupSheet Is Nothing:
      With swkstActiveFuzzyLookupSheet.ListObjects(s_FuzzyLookupResultsTable)
        Ä.EnableEvents = False
          ' This is a Fuzzy Lookup bug work-around to show an in-cell error if the output doesn't update
          If .ListColumns.Count > 1 Then
            Dim strHeaderRowRange As String: strHeaderRowRange = .HeaderRowRange.Address
            Dim varHeaders() As Variant: varHeaders = ƒ.Transpose(ƒ.Transpose(.HeaderRowRange.Value2))
            With Range(.ListColumns(2).DataBodyRange, .ListColumns(.ListColumns.Count).DataBodyRange)
              Dim strDeletedRange As String: strDeletedRange = .Address
              .Delete
            End With
            Range(strDeletedRange).Insert Shift:=xlToRight
            Range(strDeletedRange).Value2 = s_InCell_Error_Message
            Range(strHeaderRowRange).Value2 = varHeaders
          End If
          ' This is the magic line that forces the output back into the table
          .HeaderRowRange.Cells(1).Select
        Ä.EnableEvents = True
      End With
    Case TheWorksheet.Name = swkstActiveFuzzyLookupSheet.Name:
      With swkstActiveFuzzyLookupSheet.ListObjects(s_FuzzyLookupResultsTable).Range
        If Target.Cells(Target.Cells.Count).Address = .Cells(.Cells.Count).Address Then
          ' <optional>
          ' Only restore the selection if set to do so and the selection is not the first header cell
          If RESTORE_SELECTION _
          And sstrOriginalSelection <> .Cells(1).Address _
          Then
            Ä.EnableEvents = False
              Range(sstrOriginalSelection).Select
            Ä.EnableEvents = True
            ' Unfortunately the above Select doesn't stick. The Add-in trys to change the selection another 1 or 2 times.
            ' The following hack is required so that the Workbook_SheetSelectionChange handler can revert these attempts.
            ' Note that if the original selection contains the first header cell, only 1 attempt is made. Otherwise it makes 2 attempts.
            RevertSelection _
              RevertTo:=Selection, _
              NumberOfTimes:=IIf(Intersect(Selection, .Cells(1)) Is Nothing, 2, 1)
          End If
          ' </optional>
          sstrOriginalSelection = vbNullString
          Set swkstActiveFuzzyLookupSheet = Nothing
        End If
      End With
    Case Else:
      Exit Sub
   'End Cases
  End Select

End Sub

' The following code is only needed if the RESTORE_SELECTION option is required.
' If the code is removed, the optional code in the Workbook_SheetChange handler above also needs to be removed.

Private Sub RevertSelectionIfRequired()
  RevertSelection
End Sub

Private Sub RevertSelection _
            ( _
              Optional ByRef RevertTo As Range, _
              Optional ByRef NumberOfTimes As Long _
            )

  Static srngRevertTo As Range
  Static slngRevertCount As Long

  Select Case True
    Case Not RevertTo Is Nothing:
      Set srngRevertTo = RevertTo
      slngRevertCount = NumberOfTimes
    Case Not srngRevertTo Is Nothing:
      With Application
        .EnableEvents = False
        srngRevertTo.Select
        .EnableEvents = True
      End With
      slngRevertCount = slngRevertCount - 1
      If slngRevertCount = 0 Then Set srngRevertTo = Nothing
    Case Else:
      Exit Sub
   'End Cases
  End Select

End Sub

Private Sub Workbook_SheetSelectionChange _
            ( _
                       ByVal TheWorksheet As Object, _
                       ByVal Target As Range _
            )

  RevertSelectionIfRequired

End Sub