Excel宏按钮不显示正确的数据

时间:2013-11-09 09:13:46

标签: excel vba excel-vba

我有一个按钮宏,用于在保留一些(无关紧要的起始细节行)行(A1-A10)并将所有这些文件合并到单个文件中之后从excel文件中读取数据。

当我使用产品文件(具有特定产品详细信息的excel文件)时,它正确运行。但是当我使用具有公司详细信息的excel文件时,它会从不相关的行(A5)中读取一行,然后转到相关的数据部分进行读取。

我无法理解为什么它从公司excel文件中读取一行即公司名称。我希望它直接进入(A11)行阅读。它与produt文件有关。

产品文件是具有特定产品详细信息的文件。 公司文件是包含特定公司所有产品详细信息的文件。

使用下面的代码,我想知道为什么它正在阅读公司名称(第A5行),它不应该阅读。

 Sub Button2_Click()
  Dim basebook As Workbook
  Dim mybook As Workbook
  Dim sourceRange As Range
  Dim destrange As Range
  Dim SourceRcount As Long
  Dim N As Long
  Dim rnum As Long
  Dim MyPath As String
  Dim SaveDriveDir As String
  Dim FName As Variant

  SaveDriveDir = CurDir
  MyPath = "C:\"
 ChDrive MyPath
 ChDir MyPath

 FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls", _
 MultiSelect:=True)
 If IsArray(FName) Then
 Application.ScreenUpdating = False
 Set basebook = ThisWorkbook

  For N = LBound(FName) To UBound(FName)
  Set mybook = Workbooks.Open(FName(N))

  rnum = LastRow(basebook.Worksheets(1)) + 1

  Set sourceRange = mybook.Worksheets(1).UsedRange
  SourceRcount = sourceRange.Rows.Count
  Set destrange = basebook.Worksheets(1).Cells(rnum, "A")

   'basebook.Worksheets(1).Cells(rnum, "D").Value = mybook.Name
  ' This will add the workbook name in column D if you want

   sourceRange.Copy destrange
   ' Instead of this line you can use the code below to copy only the values

   ' With sourceRange
   ' Set destrange = basebook.Worksheets(1).Cells(rnum, "A"). _
   ' Resize(.Rows.Count, .Columns.Count)
   ' End With
   ' destrange.Value = sourceRange.Value

   mybook.Close False

  'Clear Rows
     rnum = LastRow(basebook.Worksheets(1)) + 1
       While Not rnum = 2
      If basebook.Worksheets(1).Cells(rnum, 1).Value = "" Or
        Left(basebook.Worksheets(1).Cells
              (rnum, 1).Value, 9) = "Copyright" Or Left                                                      
          (basebook.Worksheets(1).Cells(rnum, 1).Value, 4) = "Free" Or  Left
          (basebook.Worksheets(1).Cells(rnum, 1).Value, 7) = "Product" Or
        Left(basebook.Worksheets(1).Cells(rnum, 1).Value, 9) = "Intl Port" Or 
        Left(basebook.Worksheets(1).Cells(rnum, 1).Value, 5) = "House" Or 
       Left(basebook.Worksheets(1).Cells(rnum, 1).Value, 7) = "Arrival" Or
       Left(basebook.Worksheets(1).Cells(rnum, 1).Value, 5) = "Bill " Then
       basebook.Worksheets(1).Rows(rnum).Delete
         End If
       rnum = rnum - 1
           Wend

         Next
      End If
        ChDrive SaveDriveDir
      ChDir SaveDriveDir
     Application.ScreenUpdating = True
      End Sub

      Function LastRow(sh As Worksheet)
      On Error Resume Next
      LastRow = sh.Cells.Find(What:="*", _
     After:=sh.Range("A1"), _
        Lookat:=xlPart, _
       LookIn:=xlFormulas, _
      SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, _
       MatchCase:=False).Row
       On Error GoTo 0
  End Function

1 个答案:

答案 0 :(得分:1)

而不是:

Set sourceRange = mybook.Worksheets(1).UsedRange
SourceRcount = sourceRange.Rows.Count

试试这个:

With mybook.Worksheets(1)
    SourceRcount = .UsedRange.Rows.Count
    Set sourceRange = .UsedRange.Offset(10, 0).Resize(RowSize:=SourceRcount - 10)
End With

通过直接复制您想要的内容,您可以避免以后删除行。