索引與條件（Excel或VBA）匹配

Question

我在Excel電子表格中有兩列：

A  |  B
---|---
DL | KO
D4 | KO
SO | PL
SS | PL

這只是一個示例，在我的實際電子表格中，我使用了更長的字符串。 現在，我想實現一些東西，以便下次我在以S開頭的A列中鍵入一個字符串時，它會自動為B填充PL，或者如果我鍵入以D開頭的字符串，則KO將出現在B中。如果我鍵入一個字符串，比方說AL，之前沒有發生過，默認字符串（例如“ FILL IN”或只是空字符串）放在B中。

這樣的想法是，我將不得不手動在B中輸入字符串。如果將來我輸入的字符串與AL相匹配（不是以A開頭，而是完全匹配），那么它足以識別要填寫的內容對於B。

第一種方法：Excel

使用索引匹配：

=INDEX($N:$N;MATCH(ReturnFormattedCredit($K4)&"*";$K:$K;0))

通過匹配K4中的元素作為K列中其他元素的子字符串，應該返回N列中的字符串。

輔助函數ReturnFormattedCredit是我自己創建的VBA函數：

Function ReturnFormattedCredit(c) As String
'Returns the formatted credit: For ZK credits this will be the first 3 alphabetical
'characters + the 4 following digits; for ZL credits this will be the first 2
'alphabetical characters + the following 6 digits; return the full string otherwise
    If StrComp(Left(c, 2), "ZL") = 0 Then
        ReturnFormattedCredit = Left(c, 8)
    ElseIf StrComp(Left(c, 2), "ZK") = 0 Then
        ReturnFormattedCredit = Left(c, 7)
    Else
        ReturnFormattedCredit = c
    End If
End Function

我已經測試了此函數，它可以完成預期的工作：從可能更大的字符串中僅提取必要的子字符串。 現在的問題是，它將只查找與K匹配的頂部元素，然后從該行的N列返回相應的字符串。 但是，如果第一個元素不知道字符串（這意味着：它也在使用此公式，並且手動輸入的地面真理在列中的其他位置），則將導致循環引用，因為現在該單元格將嘗試查找答案，但會不斷嘗試對其自身進行評估。

可以不使用.HasFormula來檢查單元格是否為公式，但是從上面的示例中，我似乎無法以此方式提取要在INDEX的第二個參數中返回的特定單元格。

第二種方法：VBA

所以我太缺乏經驗了，無法弄清楚如何在Excel中執行此操作：請在VBA中嘗試。

Function GetProjectName(targetarray As Range, kredietarray As Range, krediet) As String
    For Each el In kredietarray.Cells
        targetEl = targetarray(el.Row - 1)
        If StrComp(ReturnFormattedCredit(krediet) & "*", el) And Not targetEl.HasFormula Then
            GetProjectName = "test"
            ' GetProjectName = targetEl
        End If
    Next
    GetProjectName = "No project name found"
End Function

我傳遞了從中提取字符串的列，要搜索的列以及將字符串分別與之進行比較的單元格：

=GetProjectName($N2:$N10;$K2:$K10;$K5)

這應該成為：

=GetProjectName($N:$N;$K:$K;$K5)

對於K列中的每個單元格，我將嘗試將K5與該單元格匹配。 如果存在匹配項，則進行第二次檢查：同一行但第N列中的單元格不能為Excel公式。 如果是這樣，那么我已經找到了想要的字符串，並且必須返回該字符串。 如果它是Excel公式，請繼續查找。

不幸的是，這要么找不到任何東西（打印無效值），要么只打印0。在得知該函數通常無法正確執行並且無法弄清原因之前，在此函數中發送了Debug.Print消息。

Answer 1

如果您改寫這個問題，可能的解決方案將變得更加明顯。 因此，您可以說任務是：

1. 在“ A”列中捕獲單元格的變化。 將單元格值用作數據庫查找中的鍵，如果該項目存在，則使用該項目填充“ B”列中的單元格。
2. 在“ B”列中捕獲單元格的變化。 檢查“ A”列中的單元格是否包含數據庫中尚不存在的密鑰，如果不存在，則添加該項和密鑰。

可以使用Collection作為數據庫和Worksheet_Change事件來完成。 因此，在Sheet1（或任何適用的工作表）后面的代碼中，您可以粘貼以下內容：

Option Explicit
Private Const ENTRY_COL As Long = 1
Private Const ENTRY_ROW As Long = 1
Private Const OUTPUT_COL As Long = 2
Private Const OUTPUT_ROW As Long = 1
Private mInitialised As Boolean
Private mOutputList As Collection

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range
    Dim entryKey As String
    Dim v As Variant

    If Not mInitialised Then Initialise

    For Each cell In Target.Cells
        'Handle if change is in col "A"
        If Not Intersect(cell, Me.Columns(ENTRY_COL)) Is Nothing Then
            If Len(cell.Value2) > 0 Then
                'Look up item with key
                entryKey = Left$(cell.Value2, 1)
                v = Empty
                On Error Resume Next
                v = mOutputList(entryKey)
                On Error GoTo 0
                Application.EnableEvents = False
                'If item is found, fill col "B"
                If Not IsEmpty(v) Then
                    Me.Cells(cell.Row, OUTPUT_COL).Value = v
                Else
                    Me.Cells(cell.Row, OUTPUT_COL).Value = "FILL IN"
                End If
                Application.EnableEvents = True
            End If
        'Handle if change is in col "B"
        ElseIf Not Intersect(cell, Me.Columns(OUTPUT_COL)) Is Nothing Then
            If Len(Me.Cells(cell.Row, ENTRY_COL).Value2) > 0 Then
                'Look up item with key
                entryKey = Left$(Me.Cells(cell.Row, ENTRY_COL).Value2, 1)
                v = Empty
                On Error Resume Next
                v = mOutputList(entryKey)
                On Error GoTo 0
                'If nothing found then add new item to list
                If IsEmpty(v) Then mOutputList.Add cell.Value2, entryKey
            End If
        End If
    Next


End Sub

Private Sub Initialise()
    Dim r As Long
    Dim rng As Range
    Dim v As Variant
    Dim entryKey As String
    Dim outputStr As String

    'Define the range of populated cells in columns "A" & "B"
    Set rng = Me.Range(Me.Cells(ENTRY_ROW, ENTRY_COL), _
                       Me.Cells(Me.Rows.Count, OUTPUT_COL).End(xlUp))

    'Read the values into an array
    v = rng.Value2
    Set mOutputList = New Collection

    'Populate the collection with item from col "B" and key from col "A"
    For r = 1 To UBound(v, 1)
        If Not IsEmpty(v(r, 1)) And Not IsEmpty(v(r, 2)) Then
            entryKey = Left$(v(r, 1), 1)
            outputStr = CStr(v(r, 2))
            On Error Resume Next
            mOutputList.Add outputStr, entryKey
            On Error GoTo 0
        End If
    Next

    mInitialised = True
End Sub