vba Excel宏将数据插入下一行

Excel Macro to Insert Data into Next Row

提问by user1766898

I can't seem to figure out how to offset the information into the next row down.

我似乎无法弄清楚如何将信息偏移到下一行。

What I'm trying to do is insert the same information on the next row down every time this macro is executed. I'm using it as a cheap for of Learning Management System to track completion of eLearning courses, so every time a user executes the macro it will list the date, course, and their username.

我想要做的是每次执行此宏时在下一行插入相同的信息。我使用它作为学习管理系统的廉价工具来跟踪电子学习课程的完成情况，因此每次用户执行宏时，它都会列出日期、课程和他们的用户名。

The information in .Cells(1, 1)is incorrect, but I just used that to ensure the rest of the macro was working. At this point I just need to figure out how build in the logic to move down one row each time the macro is executed.

中的信息.Cells(1, 1)不正确，但我只是用它来确保宏的其余部分正常工作。在这一点上，我只需要弄清楚每次执行宏时如何构建逻辑以向下移动一行。

Thanks in advance for your help!

在此先感谢您的帮助！

Sub Test()
    Dim objNetwork
    Set objNetwork = CreateObject("WScript.Network")
    strUserName = objNetwork.UserName

    Set objExcel = CreateObject("Excel.Application")
    Set objWorkbook = objExcel.Workbooks.Open("G:\Training\GPL\Test.xlsx")
    objExcel.Application.DisplayAlerts = False
    objExcel.Application.Visible = False
    objWorkbook.Worksheets(1).Activate
    objWorkbook.Worksheets(1).Cells(1, 1).Value = "GPL Overview"
    objWorkbook.Worksheets(1).Cells(1, 2).Value = strUserName
    objWorkbook.Worksheets(1).Cells(1, 3).Value = Date

    'objExcel.ActiveWorkbook.Save "G:\Training\GPL\Test.xlsx"
    objExcel.ActiveWorkbook.SaveAs "G:\Training\GPL\Test.xlsx"
    objExcel.ActiveWorkbook.Close
    'objExcel.ActiveWorkbook.

    'objExcel.Application.Quit
    'WScript.Echo "Finished."
    'WScript.Quit

    objExcel.Application.Quit
End Sub

回答by Scott Holtzman

This should fix it for you. Add this right after objWorkbook.Worksheets(1).Activate

这应该为您解决。紧随其后添加这个objWorkbook.Worksheets(1).Activate

Dim lastrow as Long
lastrow = objExcel.Worksheets(1).Range("A" & objExcel.Worksheets(1).Rows.Count).End(xlup).Row + 1

And change the next three lines to this:

并将接下来的三行更改为：

objWorkbook.Worksheets(1).Cells(lastrow, 1).Value = "GPL Overview"
objWorkbook.Worksheets(1).Cells(lastrow, 2).Value = strUserName
objWorkbook.Worksheets(1).Cells(lastrow, 3).Value = Date

Update

更新

Since it looks like you are running this code inside Excel itself, I am going to show you how you can really clean this code up and allow it to run faster and be easier to decipher. See the code below:

由于看起来您是在 Excel 内部运行此代码，因此我将向您展示如何真正清理此代码并使其运行得更快且更易于破译。请参阅下面的代码：

Option Explicit

Sub Test()

Dim strUserName as String
strUserName = ENVIRON("username")

With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
End With

Dim objWorkbook as Workbook
Set objWorkbook = Workbooks.Open("G:\Training\GPL\Test.xlsx")

Dim wks as Worksheet
Set wks = objWorkbook.Sheets(1)

With wks
    Dim lastrow as Long
    lastrow = .Range("A" & .Rows.Count).End(xlup).Row + 1

    .Cells(lastrow, 1).Value = "GPL Overview"
    .Cells(lastrow, 2).Value = strUserName
    .Cells(lastrow, 3).Value = Date

End WIth

objWorkbook.Close True

With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With

End Sub

回答by imtiyaz

Thanks Scott Holtzman
I had a similar problem although i had to change some settings but after few long days you came to my rescue. Thanks indeed for help.
Here is a code i implemented and your reply helped me.

谢谢 Scott Holtzman
我遇到了类似的问题，虽然我不得不更改一些设置，但几天后你来救我了。确实感谢您的帮助。
这是我实现的代码，您的回复帮助了我。

Private Sub Btn_Save_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Btn_Save.Click

        Dim MyExcel As Microsoft.Office.Interop.Excel.Application
        MyExcel = New Microsoft.Office.Interop.Excel.Application
        Dim wb As Microsoft.Office.Interop.Excel.Workbook
        wb = MyExcel.Workbooks.Open("C:\Users\IMTIYAZ\Desktop\try")
        Dim ws As Microsoft.Office.Interop.Excel.Worksheet
        ws = wb.Sheets("sheet1")
        With ws
            Dim irow As Long
            irow = ws.Range("A65536").End(Excel.XlDirection.xlUp).Offset(1, 0).Select
            irow = ws.Range("A" & ws.Rows.Count).End(Excel.XlDirection.xlUp).Row + 1
            ws.Cells(irow, 1).Value = Me.txtSn.Text
            ws.Cells(irow, 2).Value = Me.txtNa.Text
            ws.Cells(irow, 3).Value = Me.txtGpf.Text
            ws.Cells(irow, 4).Value = Me.txtBa.Text
            ws.Cells(irow, 5).Value = Me.txtBn.Text
            ws.Cells(irow, 6).Value = Me.txtAp.Text
            ws.Cells(irow, 7).Value = Me.txtBp.Text
            ws.Cells(irow, 8).Value = Me.txtGp.Text
            ws.Range(irow, 9).Formula = ("=$G+$H")
            Me.Lbl_Tt.Text = ws.Cells(irow, 9).Value
            ws.Cells(irow, 10).Value = Me.txtPp.Text
            ws.Cells(irow, 11).Value = Me.txtDa.Text
            ws.Cells(irow, 12).Value = Me.txtMa.Text
            ws.Cells(irow, 13).Value = Me.txtRa.Text
            ws.Cells(irow, 14).Value = Me.txtCa.Text
            ws.Cells(irow, 15).Value = Me.txtOa.Text
            ws.Cells(irow, 16).Formula = ("=i3+J3+K3+L3+M3+N3+O3")
            Me.Lbl_Gt.Text = ws.Cells(irow, 16).Value
            ws.Cells(irow, 17).Value = Me.txtFa.Text
            ws.Cells(irow, 18).Formula = ("=P3-Q3")
            Me.Lbl_Naf.Text = ws.Cells(irow, 18).Value
            ws.Cells(irow, 19).Value = Me.txtSf.Text
            ws.Cells(irow, 20).Value = Me.txtRf.Text
            ws.Cells(irow, 21).Value = Me.txtSi1.Text
            ws.Cells(irow, 22).Value = Me.txtSi2.Text
            ws.Cells(irow, 23).Value = Me.txtSi3.Text
            ws.Cells(irow, 24) = ("=S3+T3+V3+W3+U3")
            Me.Lbl_Td.Text = ws.Cells(irow, 24).Value
            ws.Cells(irow, 25).Formula = ("=R3-X3")
            Me.Lbl_Nad.Text = ws.Cells(irow, 25).Value
            ws.Cells(irow, 26).Value = Me.txtHl.Text
            ws.Cells(irow, 27).Value = Me.txtCsc.Text
            ws.Cells(irow, 28).Value = Me.txtMr.Text
            ws.Cells(irow, 29).Value = Me.txtIt.Text
            ws.Cells(irow, 30).Formula = ("=Y3-(AC3+Z3+AA3+AB3)")
            Me.Lbl_Np.Text = ws.Cells(irow, 30).Value
            MessageBox.Show("The last row in Col A of Sheet1 which has data is " & irow)
        End With
        MyExcel.Quit()
        MyExcel = Nothing
        Me.Update()
    End Sub
End Class