指數與之匹配的條件（Excel或VBA）

Question

我有一個Excel電子表格兩列：

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

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

這個想法是，我將不得不手動輸入如果將來我輸入一個匹配AL的字符串（不是從A開始，但是完全匹配），它將足夠聰明以識別要填寫的內容B.

第一種方法：Excel

使用折射率匹配：

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

這是應該返回字符串在列N，由K.

在K4的元件匹配如在列中的其它元素的子串的輔助函數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說完垃圾郵件調試。在獲知該函數經常無法正確執行之前，先打印此函數中的消息，但我無法弄清楚原因。

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