导入Excel工作簿并根据条件输出一些行和列

我正在尝试使用VBA来要求某人select一个Excel文件，如果该文件符合条件，我想输出某些列到一个新的工作簿。

我开始创build允许用户select文件的脚本，然后尝试testing是否可以看到一些数据输出，但是我不知所措。 我的逻辑似乎没有办法！ 我已经提供了下面的代码。 这似乎没有多大意义，但在我出轨之前，我的想法是：

1. 用户打开Excel文件（其中的macros）
2. 当脚本运行时，浏览面板打开，select一个Excel文件
3. 如果该Excel文件（工作簿）包含单元格8中的string（也循环），然后在新的工作簿中输出列的范围。

代码如下：

Sub Import2() Dim Input_Workbook As Workbook Dim Output_Workbook As Workbook Dim Source_Path As String Dim LastRow As Long, erow As Long LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row Source_Path = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS*), *.XLS*", Title:="Select File To Be Opened") Set Input_Workbook = Workbooks.Open(Source_Path) For i = 2 To LastRow If Cells(i, 8) = "231/8151" Then Range(Cells(i, 1), Cells(i, 7)).Select Selection.Copy Set Output_Workbook = ThisWorkbook Set Input_Workbook = Workbooks.Open(Source_Path) Imported_Workbook.Sheets(1).Select erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row Input_Workbook.Cells(erow, 1).Select Input_Workbook.Paste Input_Workbook.Save Input_Workbook.Close Input_Workbook = False End If Output_Workbook.Save Input_Workbook.Save Input_Workbook.Close False Next i End Sub 

Answer 1

看来你已经交换了你的input和输出工作簿。 您打开工作簿的方法是正确的，但是您需要预测用户正在Cancelling或Closing对话框。

 Dim Source_Path As Variant ' Declare as Variant and not as string Source_Path = Application.GetOpenFileName("Excel Files (*.xls*), *.xls*", , _ "Select File To Be Opened", ,True) If Not IsArray(Source_Path) Then Msgbox "No File Selected. Exiting Now": Exit Sub 

现在照顾你的input和输出工作簿。

 Dim Input_Workbook As Workbook, Output_Workbook As Workbook Set Output_Workbook = ThisWorkbook: Set Input_Workbook = Workbooks.Open(Source_Path) 

现在，您需要在Input_Workbook检查哪张表？
我假设你只有一个工作表，所以：

 Dim what_to_find As String, found_rng As Range Dim LastRow As Long Dim Output_Worksheet As Worksheet: Set Output_Worksheet = Output_Workbook.Sheets(1) what_to_find = "231/8151" With Input_Workbook.Sheets(1) Set found_rng = .Range("H:H").Find(what_to_find) 'execute find first If found_rng Is Nothing Then MsgBox "No Match Found. Exiting Now.": Exit Sub LastRow = .Range("H" & .Rows.Count).End(xlup).Row ' Now, an alternative to looping is using AutoFilter Method .Range("A1:H" & LastRow).AutoFilter 8, what_to_find ' filter all matches .Range("A2:G" & LastRow).SpecialCells(xlCellTypeVisible).Copy Output_Worksheet.Range("A" & Output_Worksheet.Rows.Count).End(xlUp).Offset(1, 0) _ .PasteSpecial xlPasteValues ' or xlPasteAll End With 

其他假设包括：

1. 你真的匹配或search一个文本或string，而不是公式或其中的一部分。
2. 您需要复制值，而不是公式。 否则，使用xlPasteAll

此外， 请检查了解如何避免使用select和熟悉如何使用对象。 你真的很接近，你只是在循环中的复制和粘贴部分混淆。 希望这个和我build议的链接指导你使你的代码工作，并帮助你完成你所需要的。