My Do Until宏不做任何事情

时间：2013-04-09 21:43:43

标签： excel vba loops

我正在创建一个迭代循环来解决Darcy-Weisbach闭合管道循环。有4个循环。我试图重复所有4个循环的迭代，直到磁头损失低于某个值（0.0001）。我记录了一个宏，然后尝试修改它以进行尽可能多的迭代，以达到低于0.0001。宏基本上从先前的迭代和循环中提取值并将它们放入新的迭代中。我是vba的新手，我不确定这里的问题是什么，但宏根本不会运行。它没有说有任何错误，它只是没有做任何事情。也许有人知道问题是什么？

Sub Iterate()
'
' Iterate Macro
'
'
Dim RowStart As Long
Dim HeadLoss As Long
Dim Count As Long
    RowStart = 19
    HeadLoss = 0
    Count = 2
Do Until HeadLoss <= 0.0001
' Copy Previous Iteration
    Range(Cells(RowStart, 1), Cells(RowStart + 32, 7)).Select
    Selection.Copy
    Range(Cells(RowStart + 34, 1)).Select
    ActiveSheet.Paste
    Range(Cells(RowStart + 34, 1)).Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Iteration" & Count
' Loop 1
    Range(Cells(RowStart + 37, 2)).Select
    ActiveCell.FormulaR1C1 = "=R[-34]C[5]"
    Range(Cells(RowStart + 38, 2)).Select
    ActiveCell.FormulaR1C1 = "=-R[-18]C[5]"
    Range(Cells(RowStart + 39, 2)).Select
    ActiveCell.FormulaR1C1 = "=R[-34]C[5]"
    Range(Cells(RowStart + 40, 2)).Select
    ActiveCell.FormulaR1C1 = "=-R[-29]C[5]"
    Range(Cells(RowStart + 37, 7)).Select
    ActiveCell.FormulaR1C1 = "=RC[-5]-R61C5"
    Range(Cells(RowStart + 37, 7)).Select
    Selection.AutoFill Destination:=Range(Cells(RowStart + 37, 7), 
        Cells(RowStart + 40, 7)), Type:=xlFillDefault
' Loop 2
    Range(Cells(RowStart + 45, 2)).Select
    ActiveCell.FormulaR1C1 = "=-R[-5]C[5]"
    Range(Cells(RowStart + 46, 2)).Select
    ActiveCell.FormulaR1C1 = "=R[-34]C[5]"
    Range(Cells(RowStart + 47, 2)).Select
    ActiveCell.FormulaR1C1 = "=R[-34]C[5]"
    Range(Cells(RowStart + 48, 2)).Select
    ActiveCell.FormulaR1C1 = "=-R[-18]C[5]"
    Range(Cells(RowStart + 45, 7)).Select
    ActiveCell.FormulaR1C1 = "=RC[-5]-R69C5"
    Range(Cells(RowStart + 45, 7)).Select
    Selection.AutoFill Destination:=Range(Cells(RowStart + 45, 7), 
        Cells(RowStart + 48, 7)), Type:=xlFillDefault
' Loop 3
    Range(Cells(RowStart + 53, 2)).Select
    ActiveCell.FormulaR1C1 = "=R[-34]C[5]"
    Range(Cells(RowStart + 54, 2)).Select
    ActiveCell.FormulaR1C1 = "=-R[-50]C[5]"
    Range(Cells(RowStart + 55, 2)).Select
    ActiveCell.FormulaR1C1 = "=-R[-16]C[5]"
    Range(Cells(RowStart + 56, 2)).Select
    ActiveCell.FormulaR1C1 = "=-R[-29]C[5]"
    Range(Cells(RowStart + 53, 7)).Select
    ActiveCell.FormulaR1C1 = "=RC[-5]-R77C5"
    Range(Cells(RowStart + 53, 7)).Select
    Selection.AutoFill Destination:=Range(Cells(RowStart + 53, 7), 
        Cells(RowStart + 56, 7)), Type:=xlFillDefault
' Loop 4
    Range(Cells(RowStart + 61, 2)).Select
    ActiveCell.FormulaR1C1 = "=-R[-5]C[5]"
    Range(Cells(RowStart + 62, 2)).Select
    ActiveCell.FormulaR1C1 = "=R[-34]C[5]"
    Range(Cells(RowStart + 63, 2)).Select
    ActiveCell.FormulaR1C1 = "=R[-34]C[5]"
    Range(Cells(RowStart + 64, 2)).Select
    ActiveCell.FormulaR1C1 = "=-R[-16]C[5]"
    Range(Cells(RowStart + 61, 7)).Select
    ActiveCell.FormulaR1C1 = "=RC[-5]-R84C5"
    Range(Cells(RowStart + 61, 7)).Select
    Selection.AutoFill Destination:=Range(Cells(RowStart + 61, 7), 
        Cells(RowStart + 64, 7)), Type:=xlFillDefault

    HeadLoss = Cells(RowStart + 41, 5).Value + Cells(RowStart + 49, 5).Value +   
        Cells(RowStart + 57, 5).Value + Cells(RowStart + 65, 5).Value
    RowStart = RowStart + 34
    Count = Count + 1
Loop

End Sub

感谢帮助人员，我肯定会越来越近了。我还有一个问题。我希望宏循环，直到HeadLoss小于0.0001。目前迭代只运行一次，HeadLoss约为0.2058，显然大于0.0001。为什么它只在一次迭代后停止？

Sub Iterate()
'
' Iterate Macro
'

'
Dim RowStart As Long
Dim HeadLoss As Long
Dim Count As Long
    RowStart = 19
    HeadLoss = 1
    Count = 2
Do While HeadLoss >= 0.0001
' Copy Previous Iteration
    With ActiveSheet
    Range(.Cells(RowStart, 1), .Cells((RowStart + 32), 7)).Copy 
          .Cells(RowStart + 34, 1)
    .Cells(RowStart + 34, 1).Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Iteration" & Count
' Loop 1
    .Cells(RowStart + 37, 2).FormulaR1C1 = "=R[-34]C[5]"
    .Cells(RowStart + 38, 2).FormulaR1C1 = "=-R[-18]C[5]"
    .Cells(RowStart + 39, 2).FormulaR1C1 = "=R[-34]C[5]"
    .Cells(RowStart + 40, 2).FormulaR1C1 = "=-R[-29]C[5]"
    .Cells(RowStart + 37, 7).FormulaR1C1 = "=RC[-5]-R61C5"
    .Cells(RowStart + 37, 7).AutoFill Destination:=Range(Cells(RowStart + 37, 7),
        Cells(RowStart + 40, 7)), Type:=xlFillDefault
' Loop 2
    .Cells(RowStart + 45, 2).FormulaR1C1 = "=-R[-5]C[5]"
    .Cells(RowStart + 46, 2).FormulaR1C1 = "=R[-34]C[5]"
    .Cells(RowStart + 47, 2).FormulaR1C1 = "=R[-34]C[5]"
    .Cells(RowStart + 48, 2).FormulaR1C1 = "=-R[-18]C[5]"
    .Cells(RowStart + 45, 7).FormulaR1C1 = "=RC[-5]-R69C5"
    .Cells(RowStart + 45, 7).AutoFill Destination:=Range(Cells(RowStart + 45, 7), 
        Cells(RowStart + 48, 7)), Type:=xlFillDefault
' Loop 3
    .Cells(RowStart + 53, 2).FormulaR1C1 = "=R[-34]C[5]"
    .Cells(RowStart + 54, 2).FormulaR1C1 = "=-R[-50]C[5]"
    .Cells(RowStart + 55, 2).FormulaR1C1 = "=-R[-16]C[5]"
    .Cells(RowStart + 56, 2).FormulaR1C1 = "=-R[-29]C[5]"
    .Cells(RowStart + 53, 7).FormulaR1C1 = "=RC[-5]-R77C5"
    .Cells(RowStart + 53, 7).AutoFill Destination:=Range(Cells(RowStart + 53, 7), 
        Cells(RowStart + 56, 7)), Type:=xlFillDefault
' Loop 4
    .Cells(RowStart + 61, 2).FormulaR1C1 = "=-R[-5]C[5]"
    .Cells(RowStart + 62, 2).FormulaR1C1 = "=R[-34]C[5]"
    .Cells(RowStart + 63, 2).FormulaR1C1 = "=R[-34]C[5]"
    .Cells(RowStart + 64, 2).FormulaR1C1 = "=-R[-16]C[5]"
    .Cells(RowStart + 61, 7).FormulaR1C1 = "=RC[-5]-R84C5"
    .Cells(RowStart + 61, 7).AutoFill Destination:=Range(Cells(RowStart + 61, 7),     
        Cells(RowStart + 64, 7)), Type:=xlFillDefault
' Check to see if another iteration is needed
    HeadLoss = Abs(Cells(RowStart + 41, 5).Value) + 
        Abs(Cells(RowStart + 49, 5).Value) + 
        Abs(Cells(RowStart + 57, 5).Value)+       
        Abs(Cells(RowStart + 65, 5).Value)
    RowStart = RowStart + 34
    Count = Count + 1
    End With
Loop

End Sub

1 个答案:

答案 0 :(得分：0)

Sub Iterate()
    '
' Iterate Macro
'
'
Dim RowStart As Long
Dim HeadLoss As Long
Dim Count As Long
    RowStart = 19
    HeadLoss = 0
    Count = 2
Do While HeadLoss <= 0.0001
' Copy Previous Iteration

   With ActiveSheet
    Range(.Cells(RowStart, 1), .Cells((RowStart + 32), 7)).Copy .Cells(RowStart + 34, 1)

    .Cells(RowStart + 34, 1).Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Iteration" & Count

For i = 1 To 4
    .Cells(RowStart + 37, 2).FormulaR1C1 = "=R[-34]C[5]"
    .Cells(RowStart + 38, 2).FormulaR1C1 = "=-R[-18]C[5]"
    .Cells(RowStart + 39, 2).FormulaR1C1 = "=R[-34]C[5]"
    .Cells(RowStart + 40, 2).FormulaR1C1 = "=-R[-29]C[5]"
    .Cells(RowStart + 37, 7).FormulaR1C1 = "=RC[-5]-R61C5"
    .Cells(RowStart + 37, 7).AutoFill Destination:=Range(Cells(RowStart + 37, 7), Cells(RowStart + 40, 7)), Type:=xlFillDefault
Next i

    HeadLoss = .Cells(RowStart + 41, 5).Value + .Cells(RowStart + 49, 5).Value + .Cells(RowStart + 57, 5).Value + .Cells(RowStart + 65, 5).Value
    RowStart = RowStart + 34
    Count = Count + 1
   End With
Loop

End Sub
相关问题
最新问题