☰

填充单元格，新条目始终位于顶部，并添加序列号

tag-icon • tag-icon microsoft-excel macros
填充单元格，新条目始终位于顶部，并添加序列号

我对 Excel 中的 VBA 还很陌生，但我正在做的一个小项目需要它，需要您的帮助。

我需要做的是在工作簿中一张单独的工作表（“机器”）上填充一个列表，该列表来自我输入信息的另一张工作表（“新机器”），在“新机器”工作表上输入的信息将被清除，准备进行另一次输入。

我希望新条目出现在列表顶部，并在该行添加 2 个连续的数字，与新条目相对应。

本质上

A 列 B 列 C 列

... ... ...

2 2 信息

1 1 信息

这是我目前拥有的代码：

Sub capturedata()

Dim wks As Worksheet
Dim lastrow As Long

Set wks = Sheets("Machines")

lastrow = wks.Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row


wks.Cells(lastrow + 1, 3).Value = Cells(6, 2).Value
wks.Cells(lastrow + 1, 4).Value = Cells(7, 2).Value
wks.Cells(lastrow + 1, 5).Value = Cells(8, 2).Value
wks.Cells(lastrow + 1, 6).Value = Cells(9, 2).Value
wks.Cells(lastrow + 1, 7).Value = Cells(10, 2).Value
wks.Cells(lastrow + 1, 8).Value = Cells(11, 2).Value
wks.Cells(lastrow + 1, 9).Value = Cells(12, 2).Value
wks.Cells(lastrow + 1, 10).Value = Cells(13, 2).Value
wks.Cells(lastrow + 1, 11).Value = Cells(14, 2).Value


Range("B6:B14").ClearContents

End Sub

这样我就可以从上到下输入信息来填充列表，但仅此而已。

答案1

新作品登上榜首

在第二行上方插入新行，而不是查找lastrow

您还可以复制整个范围一次，而不必遍历每个单元格。

Sub capturedata()

    Dim wks As Worksheet

    Set wks = Sheets("Machines")

    With wks
        .Rows(2).EntireRow.Insert
        .Range("C2:K2") = Range("B6:B14").Value
    End With

    Range("B6:B14").ClearContents

End Sub

相关内容