Надстройка нечеткого поиска вставляет результаты в полуслучайное расположение

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

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

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

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

Error picture

3
задан robinCTS
10.04.2023 22:34 Количество просмотров материала 3503
Распечатать страницу

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
1
отвечен robinCTS 2023-04-12 06:22

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

3
отвечен HackSlash 2023-04-12 08:39

Постоянная ссылка на данную страницу: [ Скопировать ссылку | Сгенерировать QR-код ]

Ваш ответ

Опубликуйте как Гость или авторизуйтесь

Имя
Вверх