Question

此代码运行良好，但存在小缺陷。我希望能在这里得到一些帮助。

此代码需要比较 2 个值并将该值等分并放在下一个单元格中。

前 2 个条件工作正常。第三个条件工作正常，但有下面提到的 2 个我需要帮助的问题。

例如，如果 X = 2 且 Y = 8，它应该根据 X 值将 Y 分成 4 个相等的部分，但它只在偏移单元格中放置 3 个 2 值
另外，如果 Y = 7 那么它应该在相应的单元格中放置值 2 2 2 1
虽然它正在为第一个具有 Y > X 的单元格进行工作，但它在下一个 Y > X 值的更远单元格中放置了不正确的值

请告知需要更改的内容。

Sub Calc()
    Dim ws As Worksheet
    Dim i, j, x, y As Variant
    Dim lrow As Long
    lrow = Worksheets("AB").Cells(Rows.Count, 1).End(xlUp).Row
    Set ws = Workbooks("BC.xlsm").Worksheets("AB")
    j = 9

    With ws
        .Activate
        For i = 2 To lrow
            x = Cells(i, 7).Value
            y = Cells(i, 8).Value
            If y < 0 Then
                Cells(i, 8).Offset(0, 1) = y
            ElseIf y <= x Then
                Cells(i, 8).Offset(0, 1) = y
            ElseIf y > x Then
                Do Until y <= x
                    Cells(i, j) = x
                    y = y - x
                    j = j + 1
                Loop
            End If
        Next i
    End With
End Sub

Answer 1

您的变量 i, j, x 没有被分配数据类型，只有 y 被分配为 variant。
如果您打算使用 With 构造，那么它应该通过 . 连接到其子对象，如下所示。

前两个条件具有相同的关联操作，因此可以通过 OR 将它们连接起来。

 Sub Calc()

 Dim ws As Worksheet
 Dim i, j, x, y
 Dim lrow As Long

 Set ws = Workbooks("BC.xlsm").Worksheets("AB")
 lrow = ws.Cells(Rows.Count, 1).End(xlUp).Row

 With ws
     For i = 2 To lrow
         x = .Cells(i, 7).Value
         y = .Cells(i, 8).Value
         j = 9
         If y < 0 Or y <= x Then
             .Cells(i, j) = y
         ElseIf y > x Then
             Do Until y <= x
                 .Cells(i, j) = x
                 .Cells(i, j + 1) = y - x
                 y = y - x
                 j = j + 1
             Loop
         End If
     Next i
 End With

 End Sub

Answer 2

我会使用一个 for 循环和一些里面的 if 逻辑：

Sub Calc()
    Dim ws As Worksheet
    Dim i As Long, j As Long, x as double, y as double
    Dim lrow As Long
    
    
    Set ws = Workbooks("BC.xlsm").Worksheets("AB")
    
    j = 9
    With ws
        lrow = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = 2 To lrow
            x = .Cells(i, 7).Value
            y = .Cells(i, 8).Value
            
            If y < 0 Then
                .Cells(i, j) = y
            ElseIf y <= x Then
                .Cells(i, j) = y
            ElseIf y > x Then
                For j = 9 To 8 + Application.RoundUp(y / x, 0)
                    If y >= x Then
                       .Cells(i, j) = x
                        y = y - x
                    Else
                        .Cells(i, j) = y
                    End If
                Next j
            End If
        Next i
    End With
End Sub

Mung Chiang's paper

嵌套 IF & Do直到循环 | VBA

2 个答案: