Как я могу заставить al oop делить каждую ячейку 3 раза?

Question

Я загрузил продукт USA Gross Domesti c, но изначально он рассчитан по триместру, и мне нужен мой месяц, поэтому я хочу разделить каждую ячейку GDP / 3, чтобы сделать мой временной ряд длиннее и иметь возможность Постройте его по месяцам: я хочу создать al oop в VBA, чтобы разделить каждое значение списка GDP 3 раза, а затем поместить его под каждым новым вычисленным значением:

Sub PIB()

Set lista = Range("D13:D275")

For Each cell In lista
    For i = 1 To 3
        Range("E13").Offset(i - 1, 0).Value = cell.Value / 3
    Next i
Next cell

End Sub

Тем не менее, когда я запускаю его , он делится правильно, но только над 3 первыми ячейками:

https://i.stack.imgur.com/pTflD.png

Я хочу эффективно разделить каждую ячейку 3 раза и поместить каждое значение друг под другом, как я могу это сделать?

Answer 1

Это то, что вы пытаетесь:

Sub PIB()

Dim arr As Variant: arr = Range("D13:D275").Value
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
Dim x As Long

For x = LBound(arr) To UBound(arr)
    For i = 1 To 3
        dict.Add Join(Array(arr(x, 1), x, i), "|"), arr(x, 1) / 3
    Next i
Next

Range("E13").Resize(dict.Count).Value = Application.Transpose(dict.Items)

End Sub

Помните о неявных Range ссылках.

Answer 2

Если вам нужно разделить каждое значение на три строки, используйте следующий код:

Sub SplitOnThreeMonths()
 Dim sh As Worksheet, arr As Variant, arrFin As Variant, lastR As Long
 Dim i As Long, j As Long, k As Long
 
   Set sh = ActiveSheet
   lastR = sh.Range("D" & Rows.count).End(xlUp).row
   arr = sh.Range("D13:D" & lastR).Value
   ReDim arrFin(1 To UBound(arr) * 3, 1 To 1)
   k = 1
   For i = 1 To UBound(arr)
    For j = 1 To 3
       arrFin(k, 1) = arr(i, 1) / 3: k = k + 1
    Next j
   Next i
   sh.Range("E13").Resize(UBound(arrFin, 1), UBound(arrFin, 2)).Value = arrFin
End Sub

Это также позволит использовать тот же продукт Gross Domesti c, даже если это маловероятно . Но кто знает?

Answer 3

Я предполагаю, что вам нужно вставить 2 строки, чтобы освободить место для разделенного значения три раза -

однако , если вам не нужно сохранять позиции данных в соседних столбцах , другие ответы, предоставленные с использованием массивов, лучше, чем этот:

Sub PIB()
For i = 275 To 13 Step -1
    Rows(i + 1 & ":" & i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range(Cells(i, "E"), Cells(i + 2, "E")).Value2 = Cells(i, "D").Value2
Next i
End Sub

Обратите внимание, что я не квалифицировал ваши диапазоны, потому что я не знаю, какими вы хотите, чтобы они были, предполагая, что это текущий лист, который вы поехали.