第二次执行宏后Shift Excel单元格向下

Shift Excel Cell down after executing a macro for second time

我编写了一个(下方)宏,它从 sql 服务器 2008 r2 中提取数据。我的问题是,当用户通过输入 Jobnumber(比如 J0001)首次运行宏时,excel 将数据放在电子表格中,从单元格 "A1" 开始,这很好。这里的问题是,当用户通过输入作业编号(例如 J0002)第二次运行宏时,excel 将作业编号 (J0002) 的数据放在单元格 "A1" 上并移动 J0001 的单元格(第一份工作)到单元格 "F" 而不是向下移动。如何将电子表格中的上一个条目向下移动,而最新的条目在顶部?

这是我的宏和附件:

Sub Task()
Dim sqlstring As String
Dim connstring As String
Dim Strcode As String
Strcode = Trim(InputBox("Please enter a Job #", "Task history"))
sqlstring = "select distinct m.JobNumber , cast(m.ExpectedDate as DATE) 'Ship Date' ,m.CustLongName 'Customer' & _
             " from ArchiveJobHeader m  left join AuxiliaryInfoFile af (nolock) on af.jobnumber=m.jobnumber & _
             " where m.JobNumber = '" & Trim(Strcode) & "'" & _
             " order by 'Resulttime'"
connstring = "ODBC;DSN=SQLDSN;UID=test;PWD=test123"
 Dim thisQT As QueryTable
 Set thisQT = ActiveSheet.QueryTables.Add(Connection:=connstring, Destination:=Range("a1", "a1000"))
 thisQT.BackgroundQuery = False
 thisQT.Sql = sqlstring
thisQT.Refresh
End Sub][1]

你可以有这样的东西:

Sub a()
'Must set Reference to "Microsoft ActiveX Data Objects 2.8 Library"
    Dim ws As Worksheet
    Dim n As Long ' Row To Write In
    Dim sql As String
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim i As Long

    Set ws = ThisWorkbook.Worksheets("Tab Name")
    'Assuming you already have Headings in row 1 _
        and start adding records from "A2" down...
    n = ws.Range("A10000").End(xlUp).row + 1
    'you sql string above is missing some double quotes...
    sql = "select distinct m.JobNumber, cast(m.ExpectedDate as DATE) 'Ship Date', m.CustLongName 'Customer'" & _
             " from ArchiveJobHeader m  left join AuxiliaryInfoFile af (nolock) on af.jobnumber=m.jobnumber" & _
             " where m.JobNumber = '" & Trim(Strcode) & "'" & _
             " order by 'Resulttime'"
    Set cn = New ADODB.Connection
    ' using an ODBC DSN... as in <http://msdn.microsoft.com/en-us/library/ms807027.aspx>
    cn.Open "SQLDSN", "test", "test123"
    Set rs = cn.Execute(sql) ' likely, in your case, to return one record only, _
                                so you are on there right away
    For i = 0 To rs.Fields.Count
        ws.Cells(n, i + 1) = rs(i)
    Next
    rs.Close
    cn.Close
End Sub

恐怕你需要在这方面投入更多的工作,但这是你可以考虑的方向。

如果合并 lastRow 检查,然后为变量分配下一行编号,则可以连接 Range,每次都会是一个新行。

Dim lastRow As Long, nextRow As Long

lastRow = Sheets("Sheet Name").Range("A" & Rows.count).End(xlUp).row
nextRow = lastRow + 1

然后在设置范围时,将变量与字符串连接起来。

Set thisQT = ActiveSheet.QueryTables.Add( _
                 Connection:=connstring, _
                 Destination:=Range("A" & nextRow))

我不确定您对问题中显示的第 1000 行做了什么。但这是使用具有正常范围地址的变量的想法。