1

現在、Office 2003 を使用して、特定の部門に関連する部門コードを含むカレンダーを作成しています。スケジュールの各「イベント」には、各日付の横に独自の部門コードのセットが隠されているため、対応する文字列を印刷しようとしています (「イベント」ごとに複数の部門コードが存在する可能性があります)。これを行うには助けが必要です。

概要

  • 部門コードは列 D の行 10 から始まります (i は行変数)。

  • これらのコードを含む各セルには、カンマで区切られた文字があります (例 [M、A、P]) - これらの各部門コード セルに基づいて複数の部門名を印刷できるようにしたいと考えています)。

  • 変数 p の意図は、vlookup を使用して各部門コードの場所を見つけることです。

  • 私の部門コードとテキスト文字列はすべて P3:Q11 にあります。列 P には部門コードが含まれ、列 Q には対応する部門名/テキスト文字列が含まれます。

  • p はループごとに 3 回ずつ増加するように設定されています。これは、次に考えられる部門コード (コンマ、スペース、新しい文字) を見つけるために 3 文字ジャンプする必要があると考えたためです。

  • 検索しているそれぞれのコードが見つかったのと同じ行に、ソロ/複数のテキスト文字列 (イベントに複数の部門コードがあるかどうかに応じて) を印刷したいと思いますが、列 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
4

1 に答える 1

1

これが、Split 関数とコレクションを使用した、私の提案するソリューションです。

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

説明が必要な場合はお知らせください

于 2013-07-03T14:04:25.000 に答える