☰

模糊查找插件将结果粘贴到半随机位置

tag-icon • tag-icon microsoft-excel
模糊查找插件将结果粘贴到半随机位置

可供参考的“Excel 模糊查找插件”现已推出这里。

我得到了一堆不断变化的“标题”——名称（一点点）和位置。因此，我去模糊匹配领域来弄清楚这次东西在哪里，以及它们叫什么。我第一次运行模糊匹配时，它就成功了！我得到了如图所示的详细信息。（指示的表Headers是源，指示的表Matching包含结果。）

然而，当我再次运行它时，结果出现在右下角，如图所示。这是为什么？我怎样才能防止这种情况发生，并让数据始终出现在我想要的位置？

（是的，我可以看到“折扣”不应该与“总金额减去折扣”第二次匹配 - 它应该是空白的。只需摆弄设置就可以解决这个问题。）

错误图片

答案1

您不能直接编写该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

答案2

表格从活动单元格开始输出。因此，您必须先单击左上角单元格，然后选择表格的显示位置，然后单击“GO”。

相关内容