从单个单元打印多个文本string

我目前正在使用Office 2003创build一个包含与某些部门相关的部门代码的日历。 计划中的每个“事件”都有自己的一组隐藏在每个date旁边的代码，我正在尝试打印相应的string（每个“事件”可以有多个代码）。 我需要帮助来做到这一点。

概要

• 部门代码在D行，从第10行开始（我是行variables）。

• 包含这些代码的每个单元格都有用逗号分隔的字母（例如[M，A，P]），我希望能够根据这些部门代码单元格中的每一个打印多个部门名称）

• 我对variablesp的意图是find每个部门代码的地方，目的是使用vlookup。

• 我所有的部门代码和文本string都在P3：Q11中find，列P包括部门代码，列Q包括相应的部门名称/文本string。

• p设置为每个循环增加3次，因为我觉得你需要跳3个字符来find下一个可能的部门代码（逗号，空格，新的字母）。

• 我想打印出与你正在查找的相应代码相同的行中的单独/多个文本string（取决于该事件是否有多个部分代码），但在列K中（而不是在哪里部门代码位于D栏）

---

Sub DepartmentNames() Dim i As Long Dim p As Integer Dim LastRow As Long LastRow = Range("D" & Rows.Count).End(xlUp).Row For i = 10 To LastRow For p = 1 To Len("D" & i) Step 3 ' Placeholder Next Next i End Sub 

Answer 1

这里是我提出的解决scheme，使用拆分function和集合。

 Sub Reference() ' Disable screen updating Application.ScreenUpdating = False Dim wS As Worksheet Set wS = ActiveSheet ' you can change it to be a specific sheet Dim i As Long Dim LastRow As Long LastRow = Range("D" & Rows.Count).End(xlUp).Row Dim Dpts As Variant Dim dFullText As Variant Dim LookUp As New Collection ' Create a collection where the key is the shortcode and the value is the full name of the dpt On Error Resume Next For i = 3 To 11 LookUp.Add wS.Cells(i, 17), wS.Cells(i, 16) Next i On Error GoTo 0 ' Loop on each row For i = 10 To LastRow Dpts = Split(wS.Cells(i, 4), ",") ' Split creates an array ' First case dFullText = LookUp.Item(Trim(Dpts(0))) ' TRIM = remove trailing and leading spaces ' The rest of them For j = 1 To UBound(Dpts) dFullText = dFullText & ", " & LookUp.Item(Trim(Dpts(j))) Next j ' Put full text in column K wS.Cells(i, 11).Value = dFullText Next i ' Enable screen updating again Application.ScreenUpdating = True End Sub 

让我知道你是否需要澄清