Question

在学校放假期间，我的任务是创建将Fibonacci序列输出到一定数量的代码（在这种情况下，我给出的数字是100000）。然后，由此，我被命令删除具有偶数的单元格，仅显示奇数的单元格。我尝试并试过了许多不同的方法，但似乎没有什么对我有用。这是我正在使用的代码：

Sub fib()

Dim x As Long

x = 100000
Range("A1") = 0
Range("A2") = 1

Do
    If Range("A" & Range("A" & Rows.Count).End(xlUp).Row).Value + _
    Range("A" & Range("A" & Rows.Count).End(xlUp).Row).Offset(-1, 0).Value >= x _
    Then Exit Sub
    Range("A" & Range("A" & Rows.Count).End(xlUp).Row).Offset(1, 0).FormulaR1C1 = _
    "=R[-1]C+R[-2]C"
Loop

        For Each Cell In Range("A1:A30")
            If Cell.Row Mod 2 = 0 Then
                Rows(Cell.Row).ClearContents
            End If
        Next
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete

End Sub

现在，我知道我的代码可能存在一些问题。我看到的主要部分是在第一个块中，而不是仅仅将数字输入到单元格中，而是输入计算的方式（例如，单元格A10的值仅为= A9 + A8）。我不确定这是否会导致代码的第二部分出错，它会查找单元格值，因此可以删除它是否为偶数。我可以就此事请一些帮助吗？我非常感激，因为我过去几天一直在努力解决这个问题。任何帮助表示赞赏！：）

Answer 1

使用公式生成30个值，然后冻结这些值（删除公式），然后删除任何超过最大值的偶数值或值：

Sub fib()
    Dim xMax As Long: xMax = 100000
    Range("A1").Value = 0: Range("A2").Value = 1
    With Range("A3:A30")
        .Formula = "=A1+A2" ' generate using formula
        .Value = .Value     ' remove formulas and freeze values
    End With
    ' now remove even values and values that exceed the xMax
    ' Remember to iterate backward when the loop involves deleting
    Dim i As Long
    For i = Cells(Rows.count, "A").End(xlUp).Row To 3 Step -1
        If Cells(i, "A").Value Mod 2 = 0 Or _
            Cells(i, "A").Value > xMax Then Rows(i).Delete
    Next
End Sub

Answer 2

尝试以下代码。

Sub fib()

Dim x As Long
Dim lRow As Long

x = 100000
Range("A1") = 0
Range("A2") = 1

Do
    If Range("A" & Range("A" & Rows.Count).End(xlUp).Row).Value + _
    Range("A" & Range("A" & Rows.Count).End(xlUp).Row).Offset(-1, 0).Value >= x _
    Then Exit Sub
    Range("A" & Range("A" & Rows.Count).End(xlUp).Row).Offset(1, 0).FormulaR1C1 = _
    "=R[-1]C+R[-2]C"

    Columns("A:A").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Loop
    With ActiveSheet

lRow = WorksheetFunction.Max(Range("A65536").End(xlUp).Row)

    For i = lRow To 2 Step -1
    If .Cells(i, "A") Mod 2 = 0 Then
      Rows(i).Delete
    End If
   Next i
   End With


End Sub

Answer 3

所有这些代码似乎都比它需要的更加漂亮。这有用吗？

Do While..Loop在A列中逐个单元格构建序列单元格，最多100,000个。

然后For Loop逐个单元格地遍历列表并删除偶数。

Sub Fib()
    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(1)
    Dim r As Long, x As Long, y As Long, z As Long, i As Long
    Dim cell As Range

    r = 1
    x = 1
    y = 0
    z = 1

    Do While z <= 100000
        ws.Range("A" & r).Value = z
        r = r + 1
        z = x + y
        y = x
        x = z
    Loop

    For Each cell In ws.Range("A1", ws.Range("A1").End(xlDown))
        If cell.Value Mod 2 = 0 Then cell.EntireRow.Delete
    Next cell
End Sub

Fibonacci序列删除偶数VBA

3 个答案: