访问2007 vba以查找Excel 2007工作表中的最后一行

时间:2013-07-21 11:01:39

标签: vba excel-vba access-vba ms-access-2007 excel-2007

我在Access 2007数据库中有一些VBA代码,用于将数据导出到Excel 2007文件。我对这段代码有疑问:

Sub GetLastRow(strSheet, strColum)
Dim MyRange As Range
Dim lngLastRow As Long

Set MyRange = Worksheets(strSheet).Range(strColum & "1")

lngLastRow = Cells(65536, MyRange.Column).End(xlUp).Row
lngLastRow = lngLastRow + 1
Rows(lngLastRow & ":1048576").Select

Selection.Delete Shift:=xlUp
End Sub

问题是变量lngLastRow不计算属于excel文件中的标题行(这些行已经在excel文件中),除非我手动打开Excel会话然后继续运行代码。我想正确解决这个问题,但至少如果我可以包含一些代码来显示excel文件,那么它会自动显示,无论如何都会解决问题。但无法看到我在哪里/如何做到这一点。

以下是调用上述函数的函数。

Function CreateExcelData()
'Copies data to be exported to an Excel workbook
Dim objExcel         As Excel.Application
Dim strTemplate      As String
Dim strPathFile      As String
Dim RowCount         As Integer
Dim wbExported       As Workbook  'The initial exported data
Dim wbAllData        As Workbook   'Workbook to copy exported data to
Dim rngUsed          As Range        'Used range in exported data
Dim Sheet            As Worksheet

'Try GetObject first in case Excel Application is already open.
On Error Resume Next
Set objExcel = GetObject(, "excel.Application")
If Err.Number <> 0 Then
    'GetObject returns error if not already open
    'so use CreateObject
    On Error GoTo 0 'Turnoff ASAP so error trapping is available
    Set objExcel = CreateObject("Excel.Application")
End If

strTemplate = "TEMPLATE.xlsm"
strPathFile = strPath & strTemplate
strPathFileFinal = strPath & strReportName & "_" & Mydat & ".xlsm"

FileCopy strPathFile, strPathFileFinal

'Open the exported data workbook and assign to a variable
Set wbExported = objExcel.Workbooks.Open(strFilePath)

'Open the data workbook to receive the exported data and assign to a variable.
Set wbAllData = objExcel.Workbooks.Open(strPathFileFinal)

'Exported data 
With wbExported.Sheets(1).UsedRange
    Set rngUsed = .Offset(1, 0) _
        .Resize(.Rows.Count - 1, .Columns.Count)
End With

With wbAllData.Sheets("MainSheet")
    'Copy exported data and paste to first empty cell of MainSheet in File
    rngUsed.Copy
    .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End With

Call GetLastRow("MainSheet", "A")

wbExported.Close

wbAllData.Save
wbAllData.Close

Set rngUsed = Nothing
Set wbExported = Nothing
Set wbAllData = Nothing
Set objExcel = Nothing

Kill strFilePath

End Function

1 个答案:

答案 0 :(得分:2)

您的代码包含许多对WorksheetsRanges的不合格且部分限定的引用。这些将引用ActiveWorkbookActiveSheet,可能不是您想要的,并且会导致不可预测的结果。

试试这个重构

Sub GetLastRow(MyRange As Excel.Range)
    Dim lngLastRow As Long

    With MyRange.Worksheet
        lngLastRow = .Cells(.Rows.Count, MyRange.Column).End(xlUp).Row
        .Range(.Cells(lngLastRow + 1, 1), .Cells(.Rows.Count, 1)).EntireRow.Delete
    End With
End Sub

像这样称呼

GetLastRow wbAllData.Worksheets("MainSheet").Columns("A")