Как ввести значение в отдельной ячейке в диапазоне и продолжить через каждую ячейку в диапазоне

Question

У меня есть диапазон A6: A24, который пуст.Я хочу вставить значение 1 в каждую ячейку и скопировать полученный расчет в H9 на новый лист.После этого я хочу перейти к следующей ячейке и вставить «1», но удалить предыдущую «1» и вставить полученное значение.

Я могу вставить 1 в каждую ячейку или только сверху.

A6: A24 - это годы.Я пытаюсь вывести расчеты, когда каждый год равен 1 (100 процентов), что означает, что все остальные годы должны быть равны нулю.

Private Sub CommandButton1_Click()

Dim inputRange1 As Range
Dim inputRange2 As Range
Dim c As Range
Dim i As Long
Dim b As Range
Dim j As Long

Set dvCell2 = Worksheets("Sheet1").Range("A6:A24")

Set inputRange2 = Worksheets("Sheet1").Range("D1")

Set dvCell1 = Worksheets("Sheet2").Range("C1")

Set inputRange1 = Worksheets("Sheet1").Range("B6:B24")

i = 1
j = 1

Application.ScreenUpdating = False
For Each b In inputRange2
    dvCell2.Value = b.Value
    For Each c In inputRange1
        dvCell1.Value = c.Value
        Worksheets("Sheet4").Cells(i + 2, j + 3).Value = Worksheets("Sheet3").Range("H9").Value
        i = i + 1
    Next c
    j = j + 1   
    i = 1
Next b
Application.ScreenUpdating = True

End Sub

Answer 1

Не уверен, что я следую. Это будет циклически проходить через каждую ячейку в dvcell2 и помещать в нее 1, а затем скопировать значение H9. Я не уверен, что вы пытаетесь сделать что-то еще.

Private Sub CommandButton1_Click()

Dim inputRange1 As Range
Dim inputRange2 As Range
Dim c As Range
Dim i As Long
Dim b As Range
Dim j As Long

Set dvcell2 = Worksheets("Sheet1").Range("A6:A24")
Set inputRange2 = Worksheets("Sheet1").Range("D1")
Set dvCell1 = Worksheets("Sheet2").Range("C1")
Set inputRange1 = Worksheets("Sheet1").Range("B6:B24")

i = 1
j = 1

Application.ScreenUpdating = False

For Each b In dvcell2
    dvcell2.value=0
    b.Value = 1
    Worksheets("Sheet4").Cells(i + 2, j + 3).Value = Worksheets("Sheet3").Range("H9").Value
    j = j + 1
Next b

Application.ScreenUpdating = True

End Sub