Question

我编写了下面的代码，我必须首先确定最小的，第二小的等等，然后获取它们的行号（我将行号保存在一个单独的列中，这里是第50列，以防万一有多个这样的数字）并按照行号的顺序将内容从一列（此处为第2列）复制到另一列（此处为第7列），即最小的第一个，然后是第二个，依此类推。

每43行开始有172个这样的数据集

这将一直持续到新列中的数字总和（每个数据集的第7列的45行）（复制数据的那一行）小于指定的数字（第1列中的45行）每个数据集，即A45，然后是A88）

编辑：上面比较的总和，即G45与A45的比较是通过表格中的公式

Dim m As Range, cl As Range, k As Double, b As Double, lIndex As Double, a As Double, multi As Double, l As Integer, x As Double

Set m = ActiveSheet.Range("E3:E40")
multi = 2                                                              'To move to starting position of the data set

For i = 1 To 172
    b = 45 + 43 * (i - 1)

    For k = 1 To 38
        a = Application.Small(m, k) 'To find the kth smallest number
        l = 1
        For j = 1 To 38             'To store the matching row numbers (Multiple instances) in column 50
                Cells(j, 50).Value = 0                                     'Initializing to column no. 50 to 0
                If Cells(j + multi, 5).Value = a Then                      'Checking for match
                    Cells(l, 50).Value = j + multi                         'Storing Row coordinates in column no. 50
                    l = l + 1
                End If
            Next j

 '==============THE FOLLOWING IS THE AREA WHERE THE PROBLEM MIGHT BE====================== 


        For o = 1 To l - 1 'To Copy the values based on the criteria
            x = Cells(o, 50).Value
            If Cells(b, 7).Value <= Cells(b, 1).Value Then             '"CRITERIA" Checking whether sum of the column is less than or equal to sum of first column of set
                Cells(x, 7).Value = Cells(x, 2).Value
            End If
        Next o

    Next k

    Set m = m.Offset(43)
    multi = multi + 43
Next i

问题是复制副本的条件（总和应小于某个值）不起作用。它实际上将第2列的所有数据复制到第7列。

有人可以帮助找到可能的原因......

注意：我检查并确认在第50列存储行号的代码工作正常。所以问题可能出在代码的下半部分，即带有变量“o”的for循环

Answer 1

我继续用这个推动自己。

意识到存在多个错误：

我不得不将新列初始化为0.我错过了。由于某些原因，将列从7更改为6。
当达到标准时，我没有退出主要的for循环，因为即使在该过程完成之后该过程也继续进行。为此使用布尔变量标志。
在计算涉及重复小函数给出的值的迭代时，变量“l”被计为1 + 1。做了适当的调整。（由于某种原因，将列从50更改为500）
我发现Excel并没有自己更新计算出的值，因此在开头包含了Application.Calculate函数。

以下是工作代码：

Application.Calculate
Dim m As Range, cl As Range, k As Double, b As Double, lIndex As Double, a As Double, multi As Double, l As Double, x As Double, Check As Double, flag As Boolean
    l = 2
    Set m = ActiveSheet.Range("E3:E40")
    multi = 2                                                             'To move to starting position of the data set
    flag = False

    For i = 1 To 172

        b = 45 + 43 * (i - 1)
        Cells(b, 6).Value = 0

        For p = 3 To 40

            Cells(p + ((i - 1) * 43), 6).Value = 0                               'Initializing to column no. 6 to 0

        Next p

        For k = 1 To 38

            If flag = True Then
            flag = 0
            Exit For
            End If

            If k + l - 2 <= 38 Then
                a = Application.Small(m, (k + l - 2))
                k = k + l - 2
            Else
                Exit For
            End If

            l = 1

            For j = 1 To 38

                Cells(j, 500).Value = 0                                     'Initializing to column no. 500 to 0

                If Cells(j + multi, 5).Value = a Then                      'Checking for match
                    Cells(l, 500).Value = j + multi                         'Storing Row coordinates in column no. 500
                    l = l + 1
                End If

            Next j

            For o = 1 To l - 1

                x = Cells(o, 500).Value
                Cells(x, 6).Value = 0
                Cells(b, 6).Value = Cells(b, 6).Value + Cells(x, 2).Value
                Check = Cells(b, 6).Value
                If Cells(b, 6).Value <= Cells(b, 1).Value Then             'Checking whether sum of the column is less than or equal to sum of first column of set
                    Cells(x, 6).Value = Cells(x, 2).Value
                Else:
                    Cells(x, 6).Value = Cells(b, 1).Value - (Cells(b, 6).Value - Cells(x, 2).Value)
                    Cells(b, 6).Value = Cells(b, 6).Value - Cells(x, 2).Value + Cells(x, 6).Value
                    flag = True
                Exit For
                End If

            Next o

        Next k

        Set m = m.Offset(43)
        multi = multi + 43

    Next i

End Sub

代码

1 个答案: