Question

我在Excel电子表格中有两列：

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

这只是一个例子，在我的实际电子表格中，我使用了更长的字符串。现在我想实现一些东西，以便下次在A列中键入一个以S开头的字符串时，它会自动填充PL为B，或者如果我键入以D开头的字符串，则KO出现在B.如果我键入字符串，比方说AL，之前没有出现过，默认字符串（例如“FILL IN”或只是空字符串）放在B中。

我的想法是，我必须手动输入B中的字符串。如果将来我键入一个匹配AL的字符串（不是以A开头，但是完全匹配），那么它将足够聪明地识别出什么填写B。

第一种方法：Excel

使用索引匹配：

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

它应该返回N列中的字符串，方法是将K4中的元素作为K列中其他元素的子字符串进行匹配。

辅助函数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

如果您重写了这个问题，可能的解决方案会变得更加明显。所以你可以说任务是：

在列＆＃34; A＆＃34;中捕获单元格的更改。将单元格值用作数据库查找中的键，如果该项存在，则在列＆＃34; B＆＃34;中填充单元格。与项目。
在列＆＃34; B＆＃34;中捕获单元格的更改。检查列中的单元格＆＃34; A＆＃34;包含一个在数据库中不存在的密钥，如果没有，则添加项目和密钥。

这可以使用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

索引与条件匹配（Excel或VBA）

1 个答案: