Question

我创建了下面的脚本来遍历工作表上的所有黄色单元格，完成后，将所有内容的最终连接结果复制/粘贴到显示黄色单元格的所有值的报告中。

基本上，脚本会产生类似的东西。

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!!

就在今天，我的同事说他们希望看到这样的结果：

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!!

如何修改代码以打印结果，就像我在上面的例子中描述的那样，for，for，每个Task＃，结果用分号分隔？我曾经设计过这段代码，并且我已经用这种格式看了一段时间，现在我似乎无法理解新的格式。

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

正如Patrick所提到的，你应该使用字典，为此你需要添加Scripting Runtime（在VBE Tools / Referenmces中/检查Microsoft Runtime Scripting）。

此代码应该可以胜任。我无法测试它因为我没有样本数据所以试试看它是否会抛出错误。你可以从那里开始。

您无需选择工作表来定义范围。如果你处理许多这样的线路，它会降低性能，除了它会闪烁，更不用说除非你真的想要在它被弹出时看表格，否则不需要选择表格

这是代码：

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

Answer 2

如果你想避免使用Dictionary，你可以使用一个额外的变量来跟踪需要写入的标题，然后在完成处理行时创建输出记录：

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

如何循环遍历单元格并使用逗号分隔的分隔符连接？

2 个答案: