Question

问题：

没有任何内容写入P列中的单元格。行Cells（x，“P”）。Value = failingClasses应该这样做。

描述:(下面的VBA脚本）

我有一个带有身份证号码的专栏。每个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

Answer 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

查找多个值，在另一列中连接相应的值，写入单元格

1 个答案: