excel vba заполнить столбец от 1 до N


Я пытаюсь написать код VBA для автоматического заполнения диапазона A1: A10000 с числами от 1 до 10000, но без ввода 1 в A1 и 2 в A2 для создания диапазона.

В принципе, мне нужен код, который выглядит следующим образом:

Set fillRange = Worksheets("Sheet1").Range("A1:A10000")
(1,2).AutoFill Destination:=fillRange

Конечно, это не работает, но вы получите то, что он.

5 2

5 ответов:

Запись и чтение на/с листа-это одни из самых медленных действий, которые вы можете выполнить. Писать экономичный по времени код - значит делать в памяти как можно больше.

Попробуйте записать все ваши значения в массив, а затем записать все это на рабочий лист одним выстрелом, что-то вроде этого:

Sub printRange(total As Integer)
Dim i, myRange() As Integer
ReDim myRange(1 To total)
    For i = 1 To total:
        myRange(i) = i
Next i

'Use Transpose to shift the 1d array into a column

Worksheets("Sheet1").Range("A1:A" & UBound(myRange)).Value = _ 
Application.WorksheetFunction.Transpose(myRange)

End Sub

Для total = 10000, это в значительной степени работает мгновенно, даже на рабочем столе динозавра десятилетней давности.

Dim fillRange As Range
Dim i As Long

Set fillRange = Worksheets("Sheet1").Range("A1:A10000")
With fillRange
    For i = .Cells(1, 1).Row To .Cells(.Rows.Count, 1).Row
        .Cells(i, 1).Value = i
    Next i
End With 'fillRange

Или с автозаполнением:

With Worksheets("Sheet1")
    Range("A1").Value = 1
    Range("A2").Value = 2
    Range("A1:A2").AutoFill Destination:=Range("A1:A10000")
End With 'Worksheets("Sheet1")

Это должно быть достаточно быстро

Можно использовать следующую функцию

Function FillNumbers(rng As Range) As Variant
    Dim i As Long
    ReDim nmbrs(1 To rng.Rows.Count)

    For i = 1 To UBound(nmbrs)
        nmbrs(i) = i
    Next
    FillNumbers = Application.Transpose(nmbrs)
End Function

Следующим образом

With Worksheets("Sheet1").Range("A1:A10000")
    .Value = FillNumbers(.Cells)
End With

Не можете ли вы использовать простой цикл?

For i = 1 to 10000
    Worksheets("Sheet1").Cells(i, 1) = i
Next i
Dim fillRagne As Range
Set fillRange = Range(Cells(1, 1), Cells(1000, 1))
For Each cell in fillRange
    cell.value = cell.Row
Next cell