Question

请点击此链接查看包含数据的Excel工作表图片：

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

我在A栏中列出了任务代码。

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

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

我想我应该将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

如何检查excel中列中是否存在字符串，其中单元格包含以逗号分隔的字符串

1 个答案: