どのようにセルをループし、コンマで区切った区切り記号で連結するのですか？

Question

シート上のすべての黄色のセルをループし、すべての最終的な連結結果をコピー/ペーストして、黄色のセルのすべての値を示すレポートにコピーするためのスクリプトを作成しました。

本質的に、スクリプトは次のようなものを生成します。 、私は私が直接、上記の例で説明したようにどこ、のために、結果を印刷するためのコードを変更するにはどうすればよい

Task#6 Map Central Email Change to: Owner Group; Owner Role; Task Description 
Task#7 Map Tri Email Change to: Owner Group; Owner Role; Task Description 
Task#14ADDED!! 

：

Task#6 Map Central Email Change to: Owner Group 
Task#6 Map Central Email Change to: Owner Role 
Task#6 Map Central Email Change to: Task Description 
Task#7 Map Tri Email Change to: Owner Group 
Task#7 Map Tri Email Change to: Owner Role 
Task#7 Map Tri Email Change to: Task Description 
If the whole row is yellow, I simply get this: 
Task#14ADDED!! 
Task#15ADDED!! 

はちょうど今日の私の同僚は、彼らがこのような結果を確認したいと述べました各タスク＃、結果はセミコロンで区切られますか？私はこのコードをしばらく設計しましたが、私はこのフォーマットでしばらく見ていましたが、今は新しいフォーマットの周りに私の心を感じることができません。

Sub UpdateFormat() 
Dim i As Long 
Dim j As Long 

Set sht = ThisWorkbook.Worksheets("Version Control") 
LRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row + 1 

Worksheets("PaperlessTemplate").Select 
    Set R = ActiveSheet.UsedRange 
    For i = 1 To R.Rows.Count 
    Worksheets("PaperlessTemplate").Select 
     For j = 1 To R.Columns.Count 
      If Cells(i, j).Interior.ColorIndex = 6 Then 
       Set Value = Cells(i, j) 
       TaskNo = Cells(i, 2) 
       TaskTitle = Cells(i, 3) 

       Title = Cells(1, j) 
        If Cells(i, 19).Interior.ColorIndex = 6 Then 
         finalset = finalset & vbCrLf & "Task#" & TaskNo & "ADDED!!" 
         GoTo here: 

         Else 
         finalset = finalset & vbCrLf & "Task#" & TaskNo & " " & TaskTitle & " " & "Change to: " & Title 
        End If 
      End If 
     Next 
here: 
    Next 

    Worksheets("Version Control").Cells(LRow, 4).Value = Worksheets("Version Control").Cells(LRow, 4).Value & finalset & vbCrLf 

End Sub 

Answer 1

あなたは辞書を避けたい場合は、あなただけのタイトルが書かれてする必要があるのを追跡するために、余分な変数を使用することができ、ここでコードがあります次に出力を作成するだけです

Sub UpdateFormat() 
    Dim i As Long 
    Dim j As Long 
    Dim LRow As Long 
    Dim sht As Worksheet 
    Dim R As Range 
    Dim TaskNo 
    Dim TaskTitle 
    Dim Title 
    Dim finalset As String 
    Dim partset As String 

    Set sht = ThisWorkbook.Worksheets("Version Control") 
    LRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row + 1 

    With Worksheets("PaperlessTemplate").UsedRange 
     For i = 1 To .Rows.Count 
      TaskNo = .Cells(i, 2).Value 
      TaskTitle = .Cells(i, 3).Value 
      If .Cells(i, 19).Interior.ColorIndex = 6 Then 
       finalset = finalset & vbCrLf & "Task#" & TaskNo & "ADDED!!" 
      Else 
       'Use a temporary variable to concatenate all the relevant titles 
       partset = "" 
       For j = 1 To .Columns.Count 
        If .Cells(i, j).Interior.ColorIndex = 6 Then 
         'Set Value = Cells(i, j) 
         Title = .Cells(1, j) 
         partset = partset & Title & "; " 
        End If 
       Next 
       'See if the temporary variable contains anything 
       If partset <> "" Then 
        'If it does, append it to the end of "finalset" 
        '(remove the last two characters from "partset" as that will be a trailing "; ") 
        finalset = finalset & vbCrLf & "Task#" & TaskNo & " " & TaskTitle & " " & "Change to: " & Left(partset, Len(partset) - 2) 
       End If 
      End If 
     Next 
    End With 

    Worksheets("Version Control").Cells(LRow, 4).Value = Worksheets("Version Control").Cells(LRow, 4).Value & finalset & vbCrLf 

End Sub 

Answer 2

パトリックで述べたように、あなたは辞書を使用する必要があり、そのためにあなたは、スクリプトランタイムを（VBEツール/ Referenmcesに/マイクロソフトのランタイムスクリプトを確認してください）を追加する必要があります。

このコードで作業を行う必要があります。私はサンプルデータを持っていないのでテストできませんでしたので、試してみてエラーが出るかどうか確認してください。あなたはそこから得ることができます。

範囲を定義するためにワークシートを選択する必要はありません。それはあなたが本当にシートを拾っている間は、シートを選択する必要はありませんが、それだけでなく、ちらつき、それ以外の多くの行を扱っている場合、パフォーマンスを遅くするでしょう

ここ

Sub UpdateFormat() 
    Dim i As Long 
    Dim j As Long 
    Dim TaskNo As String 
    Dim TaskTitle As String 
    Dim Titke As String 
    Dim dict As Dictionary 

    Set sht = ThisWorkbook.Worksheets("Version Control") 
    LRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row + 1 

    'Worksheets("PaperlessTemplate").Select 

    Set R = Worksheets("PaperlessTemplate").UsedRange 
    For i = 1 To R.Rows.Count 

    'Worksheets("PaperlessTemplate").Select 

    Set dict = New Dictionary 

    With Worksheets("PaperlessTemplate") 
     For j = 1 To R.Columns.Count 
      If .Cells(i, j).Interior.ColorIndex = 6 Then 
       Set Value = .Cells(i, j) 
       TaskNo = .Cells(i, 2) 
       TaskTitle = .Cells(i, 3) 
       Title = .Cells(1, j) 

       If .Cells(i, 19).Interior.ColorIndex = 6 Then 
        finalset = finalset & vbCrLf & "Task#" & TaskNo & "ADDED!!" 
        GoTo here: 

        Else 
         If dict.Exists(TaskNo) Then 'edit the item of dictionary with the new Title 
          finalset = dict(TaskNo) 
          dict(TaskNo) = finalset & "; " & Title 
         Else 'add to the dictionary 
          dict.Add TaskNo, "Task#" & TaskNo & " " & TaskTitle & " Change to: " & Title 
         End If 

       End If 
      End If 
     Next 
    End With 

： 次

 Worksheets("Version Control").Cells(LRow, 4).Value = Worksheets("Version Control").Cells(LRow, 4).Value & finalset & vbCrLf 

End Sub