如何检查是否在Excel中，其中细胞包含由逗号

Question

分隔串的列中存在的字符串请点击此链接上用于包含数据的Excel工作表的图像：

http://i.stack.imgur.com/Dl1YQ.gif

我有列A中的任务代码列表。

在每个任务期间，我将获得一定的胜任力。列C或列E中列出的每项能力分别在D列和F列中列出的任务期间获得。

现在我需要一个公式来告诉我关于列B（能力）的哪些能力是在列A的每个任务期间获得的。例如对于任务A2（MSC），我期望看到“Tech1，Tech2，Tech3 ，B列（B2）中的“Tech4，PS1，PS2，PS3”。

我想我应该把列A中的任务代码当作应该在列D和列F的单元格内容中查找的字符串，并且当在这些列的任何单元格中找到时，相应的能力应该从同一行中复制在单元格左边的列中输入到列B中。然后，所有这些条目在列B的每个单元格中都应以逗号分隔（如果在任务A2期间遇到多个功能）。

你能帮助我吗？

非常感谢，

哈米德

Answer 1

我同意的意见：这是VBA的任务。

我把你的GIF输入到工作表中。我没有试图解决我认为是错误的东西。例如，列A包含“SEMS”，但列D包含“SMES”。

下面的例程的第1步是对列C和D，然后列E和F进行处理，并将数据累加在结构数组中。目标是逆转的关系，得到：

MSC Tech1 Tech2 ... 
ATT Tech1 Tech2 ... 
:  : 

结果他们放置在列B

的第一步是相当复杂的。我希望我已经包含了足够的意见让你了解我的代码。缓慢地工作，并回答问题是必要的。

Option Explicit 

' VBA as intrinsic data types : string, long, double, etc. 
' You can declare an array of longs, say. 
' The size of an array can be fixed when it is declared: 
'  Dim A(1 To 5) As Long 
' or it can be declared as dynamic and then resized as necessary: 
'  Dim A() As Long 
'  ReDim A(1 to 5)   ' Initialise A with five entries 
'  ReDim Preserve A(1 to 10) ' Preserve the first five entries in A 
'        ' and add another 5. 
' 
' Sometimes a more complex structure is required. For this problem we need 
' to build a list of Tasks with a list of Competencies against each Task. 
' VBA allows us to to define the necessary structure as a "User Type" 

' Define a user type consisting of a Task name and an array of Competencies 
Type typTaskComp 
    Task As String 
    Comp() As String 
End Type 

' Declare array in which Tasks and Competencies are 
' accumulated as a dynamic array of type typTaskComp. 
Dim TaskComp() As typTaskComp 
Dim InxTaskCrntMax As Long 
Sub MatchTaskToCompetencies() 

    Dim CompListCrnt As String 
    Dim InxCompCrnt As Long ' Index for Competencies for a Task 
    Dim InxTaskCrnt As Long ' Index for Tasks 
    Dim RowCrnt As Long 
    Dim TaskCrnt As String 

    ReDim TaskComp(1 To 10)  ' Initialise TaskComp for 10 Tasks 
    InxTaskCrntMax = 0  ' The last currently used row in TaskComp. That 
           ' is, no rows are currently used. 

    ' Load array TaskComp() from the sheet 
    Call DecodeCompencyTask("Sheet1", 3, 4) 
    Call DecodeCompencyTask("Sheet1", 5, 6) 
    ' The format and contents of TaskComp is now: 
    '   Competency ... 
    ' Task 1  2  3  4  5 ... 
    ' 1 MSC Tech1 Tech2 Tech3 Tech4 PS1 
    ' 2 ATT Tech1 Tech2 Tech3 Tech4 PS1 
    ' 3 PLCY Tech1 Tech2 Tech4 Tech5 Tech6 
    ' : : 

    ' Display contents of TaskComp() to Immediate window 
    For InxTaskCrnt = 1 To InxTaskCrntMax 
    Debug.Print Left(TaskComp(InxTaskCrnt).Task & Space(5), 6); 
    For InxCompCrnt = 1 To UBound(TaskComp(InxTaskCrnt).Comp) 
     If TaskComp(InxTaskCrnt).Comp(InxCompCrnt) = "" Then 
     Exit For 
     End If 
     Debug.Print Left(TaskComp(InxTaskCrnt).Comp(InxCompCrnt) & Space(5), 6); 
    Next 
    Debug.Print 
    Next 

    ' Now place lists of Competencies in Column 2 against appropriate Task 
    RowCrnt = 2 
    With Worksheets("Sheet1") 
    TaskCrnt = .Cells(RowCrnt, 1).Value 
    Do While TaskCrnt <> "" 
     For InxTaskCrnt = 1 To InxTaskCrntMax 
     If TaskCrnt = TaskComp(InxTaskCrnt).Task Then 
      ' Have found row in TaskComp that matches this row in worksheet 
      ' Merge list of Competencies into a list separated by commas 
      CompListCrnt = Join(TaskComp(InxTaskCrnt).Comp, ",") 
      ' Empty entries at the end of TaskComp(InxTaskCrnt).Comp will 
      ' result in trailing commas. Remove them. 
      Do While Right(CompListCrnt, 1) = "," 
      CompListCrnt = Mid(CompListCrnt, 1, Len(CompListCrnt) - 1) 
      Loop 
      ' and place in column 2 
      .Cells(RowCrnt, 2).Value = CompListCrnt 
      Exit For 
     End If 
     Next 
     RowCrnt = RowCrnt + 1 
     TaskCrnt = .Cells(RowCrnt, 1).Value 
    Loop 
    End With 

End Sub 
Sub DecodeCompencyTask(WShtName As String, ColComp As Long, ColTask As Long) 

    ' Sheet WShtName contains two columns numbered ColComp and ColTask, Column 
    ' ColComp contains one Competency per cell. Column ColTask holds a comma 
    ' separated list of Tasks per cell. For each row, the Competency is gained 
    ' by performing any of the Tasks. 

    ' Scan the two columns. If a Task is missing from TaskComp() prepare a row 
    ' for it. Add the Competency to the new or existing row for the Task. 

    Dim CompCrnt As String 
    Dim Found As Boolean 
    Dim InxCompCrnt As Long ' Index for Competencies for a Task 
    Dim InxTaskCrnt As Long ' Index for Tasks 
    Dim RowCrnt As Long 
    Dim TaskCrnt As Variant 
    Dim TaskList() As String 

    With Worksheets(WShtName) 
    RowCrnt = 2 
    Do While .Cells(RowCrnt, ColComp).Value <> "" 
     CompCrnt = .Cells(RowCrnt, ColComp).Value ' Extract Competency 
     ' Remove any spaces from Task List and then split it 
     ' so there is one Task per entry in TaskList. 
     TaskList = Split(Replace(.Cells(RowCrnt, ColTask).Value, " ", ""), ",") 
     ' Process each task in TaskList 
     For Each TaskCrnt In TaskList 
     Found = False 
     ' Look for current Task in existing rows 
     For InxTaskCrnt = 1 To InxTaskCrntMax 
      If TaskComp(InxTaskCrnt).Task = TaskCrnt Then 
      Found = True 
      Exit For 
      End If 
     Next 
     If Not Found Then 
      ' New Task found. Prepare new row with Task but no 
      ' Competencies 
      InxTaskCrntMax = InxTaskCrntMax + 1 
      If InxTaskCrntMax > UBound(TaskComp) Then 
      ' No free rows in TaskComp. Add some more rows 
      ReDim Preserve TaskComp(1 To UBound(TaskComp) + 10) 
      End If 
      InxTaskCrnt = InxTaskCrntMax 
      TaskComp(InxTaskCrnt).Task = TaskCrnt 
      ReDim TaskComp(InxTaskCrnt).Comp(1 To 5) 
      ' Rely on array entries being initialised to "" 
     End If 
     Found = False 
     ' Look for an empty Competency slot in current row of TaskComp 
     For InxCompCrnt = 1 To UBound(TaskComp(InxTaskCrnt).Comp) 
      If TaskComp(InxTaskCrnt).Comp(InxCompCrnt) = "" Then 
      Found = True 
      Exit For 
      End If 
     Next 
     If Not Found Then 
      ' Row is full. Add some extra entries and set InxCompCrnt to 
      ' first of these new entries. 
      InxCompCrnt = 1 + UBound(TaskComp(InxTaskCrnt).Comp) 
      ReDim Preserve TaskComp(InxTaskCrnt).Comp(1 _ 
            To UBound(TaskComp(InxCompCrnt).Comp) + 5) 
     End If 
     TaskComp(InxTaskCrnt).Comp(InxCompCrnt) = CompCrnt 
     InxCompCrnt = InxCompCrnt + 1 
     Next 
     RowCrnt = RowCrnt + 1 
    Loop 
    End With 

End Sub