0

我有一个按钮宏，用于在离开一些（无关的详细起始行）行（A1-A10）并将所有这些文件合并到单个文件中之后从 excel 文件中读取数据。

当我使用产品文件（包含特定产品详细信息的 Excel 文件）时，它可以正常运行。但是，当我使用包含公司详细信息的 excel 文件时，它会从不相关的行（A5）中读取一行，然后转到相关的数据部分进行读取。

我无法理解为什么它从公司 excel 文件中读取一行，即公司名称。我希望它直接转到第（A11）行阅读。它与产品文件一起使用。

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

通过下面的代码，我想知道它为什么读取公司名称（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
4

1 回答 1

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

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

于 2013-11-09T14:02:00.450 回答