求助 VBA怎么按照A单元格的数值在C列自动生成对应数量的自动填充数值

1、使用Application.EnableEvents = False禁用事件，避免赋值时触发Change事件。

2、把代码复制到应用的sheet。

Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False

Application.EnableEvents = False

Dim D_row As Long, j As Long, i As Long

Columns(3).ClearContents

D_row = Range("A" & Cells.Rows.Count).End(xlUp).Row

Debug.Print D_row

For i = 1 To D_row

If Cells(i, 1) <> "" Then Cells(1, 3).Offset(j).Resize(Cells(i, 1).Value, 1) = Cells(i, 2)

j = j + Cells(i, 1).Value

Next i

Application.EnableEvents = True

Application.ScreenUpdating = True

End Sub

3、下图是运行效果图

执行结果图示

根据你图一数据及要求写了一段代码，看是不是满足要求：

1、运行前请备份原始数据表，切记！

2、为了便于检查，会自动在相关单元格写入公式。

3、代码直接放到图一的“水准测量记录”表的代码页中，如果写在模块中，请自行修改代码。代码运行后会生成图二的样子，只能运行一次，再次运行时必须保证数据格式是图一（原表）的格式。由于有几个数据是随机数，多次测试结果会不同。

4、默认图一E列是已知数据。

Sub 插入数据()

Dim i As Long

Dim k As Long

Dim n As Long

n = 8

k = 10

With ActiveSheet

For i = 11 To 65536

If .Cells(k, 4).Value - .Cells(i, 5).Value >= 0.2 And .Cells(k, 4).Value - .Cells(i, 5).Value <= 4.8 Then

.Range("C" &i) = "=$D$" &k &"-E" &i

Else

If .Cells(k, 4).Value - .Cells(i, 5).Value >= 4.8 Then

.Rows(i).Insert Shift:=xlDown

.Range("A" &i) = "ZD" &n + 1

.Range("C" &i) = "=Round(rand() * (4.8 - 4.2) + 4.2, 3)"

.Range("E" &i) = "=$D$" &k &"-C" &i

.Rows(i + 1).Insert Shift:=xlDown

.Range("B" &i + 1) = "=Round(rand() * (0.5 - 0.2) + 0.2, 3)"

.Range("D" &i + 1) = "=E" &i &"+B" &i + 1

ElseIf .Cells(k, 4).Value - .Cells(i, 5).Value <= 0.2 Then

.Rows(i).Insert Shift:=xlDown

.Range("A" &i) = "ZD" &n + 1

.Range("C" &i) = "=Round(rand() * (0.5 - 0.2) + 0.2, 3)"

.Range("E" &i) = "=$D$" &k &"-C" &i

.Rows(i + 1).Insert Shift:=xlDown

.Range("B" &i + 1) = "=Round(rand() * (4.8 - 4.2) + 4.2, 3)"

.Range("D" &i + 1) = "=E" &i &"+B" &i + 1

End If

k = i + 1

n = n + 1

i = i + 1

End If

If .Range("E" &i + 1) = "" Then Exit For

Next i

End With

End Sub

emptyrow变量等于当前激活的表格中，已经使用的行数再加上一行，就是一个空白行，不+1就会在第一列到第四列有数据时会覆盖掉原来的数据，+1就在所有数据下方一行即空白行写入新数据，所以+1是必须的，这句不加，也要在下面语句+1，如Cells(emptyrow+1, 1) = xmtxt.Text

---