Мне нужно зациклить формулу с функцией смещения, пока ячейка не станет пустой

Question

Мне нужно перебрать формулу ниже, пока столбец "B", содержащий даты, не станет пустым. Я застрял и просто не могу написать код VBA, чтобы выполнить цикл, пока в столбце "B" больше не осталось дат. Формула сглаживает доходность, используя те даты, которые имеют доходность.

Надеюсь, кто-нибудь сможет мне помочь. Заранее спасибо

      A      B       C         D
5   Factor Date    Yield     Input
6    3     May-10   .25 
7    1     Jun-10  
8    2     Jul-10  
9    3     Aug-10   0.2000 
10   1     Sep-10  
11   2     Oct-10  
12   3     Nov-10   0.2418 
13   1     Dec-10  
14   2     Jan-11  
15   3     Feb-11   0.3156 
16   1     Mar-11  
17   2     Apr-11  

---

Sub IsNumeric()
  ' IF(ISNUMBER(C6),C6,
  If Application.IsNumber(range("c6").Value) Then
    range("d6").Value = range("c6")

    ' IF(C6<C5,((OFFSET(C6,2,0)-OFFSET(C6,-1,0))*A6/3+OFFSET(C6,-1,0)),
    If range("c6").Select < range("c5").Select Then
      range("d6").Value = range("c6").Offset(2, 0).Select - range("c6").Offset(-1, 0).Select * (range("a6").Select / 3) + range("c6").Offset(-1, 0).Select

      ' IF(C6<>C7,((OFFSET(C6,1,0)-OFFSET(C6,-2,0))*(A6/3)+OFFSET(C6,-2,0)),"")))
      If range("c6").Select <> range("c7").Select Then
        range("d6").Value = (range("c6").Offset(1, 0).Select) - range("c6").Offset(-2, 0).Select * (range("a6").Select / 3) + range("c6").Offset(-2, 0).Select
      Else
        range("d6").Value = ""
      End If
    End If
  End If
End Sub

Answer 1

Sub Test01()
 Dim m, r, cell As Object
 Dim n As Boolean

 Set m = Sheets("Sheet1").Cells(1, 2)
 Do
  Set m = m.Offset(1, 0)
  Set r = m.Resize(20, 1)
  n = False
  For Each cell In r
   If cell.Formula <> "" Then
    n = True
   End If
  Next cell

  MsgBox m.Formula
 Loop Until n = False
End Sub

Это начнется в точке B1 и зациклится до конца столбца B, пока цикл не встретит ячейку, в которой под ней находятся 20 смежных пустых ячеек. Когда цикл достигнет той ячейки, в которой есть 20 последовательных пустых ячеек, он просто сместится к первой из этих пустых ячеек и остановится.

Answer 2

Если я правильно понимаю ...

1. Вам нужно будет преобразовать жестко закодированные диапазоны в переменные
2. Вы правильно используете смещение
3. Я знаю, пока / wend устарел, извините:)

---

Sub IsNumeric()
  dim tc as range

  set tc = range("B6")   'this is always column B, but the row keeps changing in the loop

  'IF(ISNUMBER(C6),C6,

  while tc <> ""
    If Application.IsNumber(tc.offset(0,1).Value) Then
      tc.offset(0,2).Value = tc.offset(0,1)

      'IF(C6<C5,((OFFSET(C6,2,0)-OFFSET(C6,-1,0))*A6/3+OFFSET(C6,-1,0)),
      If tc.offset(0,1) < tc.offset(-1,1) Then
        tc.offset(0,2).Value = tc.Offset(2, 1) - tc.Offset(-1, 1) * (tc.offset(0,-1) / 3) + tc.Offset(-1, 1)

        'IF(C6<>C7,((OFFSET(C6,1,0)-OFFSET(C6,-2,0))*(A6/3)+OFFSET(C6,-2,0)),"")))
        If tc.offset(0,1) <> tc.offset(1,1) Then
          tc.offset(0,2) = tc.offset(1,1) - tc.offset(-2,1) * (tc.offset(0,-1) / 3) + tc.offset(-2,1)
        Else
          tc.offset(0,2) = ""
        End If
      End If
    End If
    set tc=tc.offset(1,0)
  wend
End Sub