查找多个值，连接另一列中的对应值，写入单元格答案

【问题标题】：Find multiple values, concatenate cooresponding values in other column, write to cell查找多个值，连接另一列中的对应值，写入单元格
【发布时间】：2014-10-31 19:54:34
【问题描述】：

问题：

P 列的单元格中没有写入任何内容。Cells(x, "P").Value = failedClasses 行应该这样做。

说明：（下面是VBA脚本）

我有一个带有 ID 号的列。每个 ID 号可以有多行。我需要做的是连接另一列中的所有相应值并将其写入原始行的单元格中。这需要对工作表中的每一行进行。

字段 1 是 ID 所在的位置，字段 6 是我要连接的信息所在的位置，我正在尝试将连接写入列 P。

现在，我认为计算正在正确完成，但是出于什么原因它没有写入 P 中的单元格？

宏需要永远运行。运行时在 1k 到 2k 行之间。

谢谢！

Worksheets("RAW GRADE DATA").Select
    ' Turn off auto calc update and screen update -- saves speed

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False


    Dim x As Long, y As Long, totalGradeEntries As Long, failingClasses As String, failingClassesCell As Excel.Range

    totalGradeEntries = Cells(Rows.Count, 1).End(xlUp).Row
    For x = totalGradeEntries To 1 Step -1

        failingClasses = ""

        For y = totalGradeEntries To 1 Step -1

            If Cells(y, 1).Value = Cells(x, 1).Value And Cells(x, 6) <> "02HR" Then
                failingClasses = failingClasses & " " & Cells(y, 1).Value
            End If

            Cells(x, "P").Value = failingClasses
        Next y
    Next x

    ' Turn calc and screen update back on

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

【问题讨论】：

双循环会影响速度。 ID 总是连续的（排序的）还是无序的？（即无序的 123,155,123,143... 123 被其他 ID 分隔）
1.在 Cells(x,"P").Value = 行上放置一个断点，然后查看当时的 failedClasses 中的内容。 2. 只向 Cells(x,"P") 写入一次——现在您正在编写每个内部循环。 3. 要显着提高速度，请在 VBA 数组中进行“工作”，而不是在工作表上。
Portland Runner -- 我知道双循环正在扼杀速度。 ID 是无序的，但我可以在循环运行之前进行排序来解决这个问题。每个 ID 最多有 9 个条目。这可以帮助加快速度吗？
Ron Rosenfeld -- 我写每一行的原因是因为我需要稍后使用其中的一个子集（还有另一列，每个 ID 的值只显示一次。）但是，我需要首先连接所有行的数据。你能解释一下如何在数组中做“工作”吗？我知道一些 python 和 R，并且知道如何很容易地做到这一点，但我也不知道 VBA，这必须在 Excel 中完成。谢谢！
你可以写到每一行，但你只需要写一次，而不是像现在这样为每个总成绩条目写一次。对于数组，声明一个变量类型的变量，然后像 Var = RangeToProcess 这样的语句将一步将整个范围读入一个二维数组。（D1=行；D2=列）。然后迭代以处理您的数据。完成后： Range = Var 会将其输出回工作表。以我的经验，十倍的速度增加是很常见的。

标签： loops excel for-loop vba

【解决方案1】：

感谢 Ron Rosenfeld，我得到了这项工作的基本解决方案 -- 这是代码，正在处理包含 3 列数据的测试表，唯一 ID 在第 1 列中。

Sub CalcArrary()

    'Declare variables
    Dim numRows As Integer, calcArray() As Variant

    'Set the number of rows in the sheet
    numRows = ActiveSheet.Range("A1").Offset(Sheet1.Rows.Count - 1, 0).End(xlUp).Row

    ReDim calcArray(numRows - 1, 4)

    For i = 0 To numRows - 2
        calcArray(i, 1) = Range("A" & i + 2)
        calcArray(i, 2) = Range("B" & i + 2)
        calcArray(i, 3) = Range("C" & i + 2)
    Next i

    For b = 0 To numRows - 2

        For c = 0 To numRows - 2

            If calcArray(c, 1) = calcArray(b, 1) And calcArray(c, 3) < 60 Then

                calcArray(b, 4) = calcArray(b, 4) & calcArray(c, 2) & ", " & calcArray(c, 3) & "%      "

            End If

        Next c
    Next b

    For d = 0 To numRows - 2

        ActiveSheet.Range("D" & d + 2) = calcArray(d, 4)

    Next d

End Sub

【讨论】：

刚刚在我的实际数据上运行了实时版本 --- Ron Rosenfeld，非常感谢。从 60 分钟执行到 ~ 6 秒。从字面上看。