如何修改现有的VBA，以通过从一个工作表导入到另一个空值？
我一直在寻找一种方法来转换下面的答案“JDH”中的“优秀答案”（VBA代码）。 （我觉得不适合尝试下面的答案直接联系进一步的帮助）
在下面的回答/答案中的VBA答案是我所需要的90％完美的答案，但是一旦我阅读源工作簿中的零件编号和订单数量的数据（源可能是多达5000行产品，并已过滤下来以隐藏订单数量的行），下面的VBA将复制范围内的所有数据，无论是否被过滤。
（以下是接近我需要的90 +％） https://stackoverflow.com/a/7878070/1413702
我已经修改了代码，为我的实例工作，一切都很好，直到我不得不阅读零件编号和订单数量非空白的数据。 如果订单数量不是空白，我只想提出零件编号和订单数量，并且意识到我需要读取5000行的全部范围以确保获得所有可能订购的商品。 如果它是一个直接瞄准范围的源范围，那么上述方法将是完美的，因为Source可能被过滤了，所以需要检查Order Qty Blank的范围内有隐藏的行。 另外，此时可能出现的import次数的总数是LIMIT，因为订单只能设置为最多501行。 300是通用的，501是保障。 然而，我的修订版本低于这个数字，但是我没有考虑到通过潜在的5000条潜在的线路来读取这些数据，因为这是事后才想到的，而且当我试图检查一个空白值时，我发现了一个错误。 请帮助，如果可以的话，请再次提醒，如果我张贴不正确。 我会改变任何必要的符合论坛规则。 谢谢你，khleisure
我修订的“JDH”的优秀答案如下：
Private Sub ImportExternalDataToOrderForm_Click() '*******Exit Sub - Used to disable command button till sub written/executes properly ' Get customer workbook... Dim customerBook As Workbook Dim filter As String Dim caption As String Dim customerFilename As String Dim customerWorkbook As Workbook Dim targetWorkbook As Workbook ' Active workbook is the Target Workbook Set targetWorkbook = Application.ActiveWorkbook ' get the customer workbook to use as Source WorkBook filter = "XLS files (*.xls),*.xls" caption = "Please Select an input file " customerFilename = Application.GetOpenFilename(filter, , caption) Set customerWorkbook = Application.Workbooks.Open(customerFilename) ' Ranges vary in Source Workbook to Target Workbook but, applicable data to import ' to Order Form 'Import data from customer(source) to target workbook(active Order Form) Dim targetSheet As Worksheet Set targetSheet = targetWorkbook.Worksheets(2) Dim sourceSheet As Worksheet Set sourceSheet = customerWorkbook.Worksheets(1) targetSheet.Range("B4").Value = sourceSheet.Range("C2").Value ' Works Great targetSheet.Range("B9").Value = sourceSheet.Range("C8").Value ' Works Great targetSheet.Range("G9").Value = sourceSheet.Range("C9").Value 'Works Great targetSheet.Range("N4:N6").Value = sourceSheet.Range("N2:N4").Value ' Works Great targetSheet.Range("J18:J20").Value = sourceSheet.Range("K7:K9").Value ' Works Great ' Below 2 lines work great however, the Source Workbook is filtered to eliminate ' blanks in Order Qty Field (Starting Source M13) and the 2 lines of code below bring ' over everything in the overall range of 501 possible occurrences regardless if it's ' filtered or not. Blank Order Qty fields that have been filtered should not be ' imported. Max lines to import is defined by range of 501 max 'below xfers the Part Number from A column range of Source to A column Range of 'Target and works great except no function to check for blanks in Order Qty ' Below works exactly how it's written to work 'targetSheet.Range("A27:A527").Value = sourceSheet.Range("A13:A513").Value 'below xfers the Ordered Qty from M column range of Source to D column Range of 'Target and this is where I need to check if a qty has been ordered (or not = 'blank) in order to perform the above import and this import. The 2 are 'relational to one another ' Below works exactly how it's written to work but, needs to 1st check for blank 'targetSheet.Range("D27:D527").Value = sourceSheet.Range("M13:M513").Value '*****My attempt to modify further to account for blank value 'Need loop to read through each row and import Source Range "A" to Target Range '"A" along with associated Source Range "M" to Target Range "D". Max 501 lines '***** ' Need to use loop for Part Number and associated Order Qty Dim t As Long Dim s As Long Dim i As Long '***** t = 27 ' row number on target where Product # (Col A) and Order Qty (Col D) start s = 13 ' row number on Source where Product # (Col A) and Order Qty (Col M) start i = 1 ' set counter for total of 501 potential import occurrences Max ' Need to establish reading potential Source rows (filtered or not) at 5000 ' max rows (most likely range of 3500) ' for most factories and their offerings. (Have not established this ' portion yet) For i = 1 To 501 Step 1 If **sourceSheet.Range("M(s)").Value** = "" Then ' Error Here **************** **'Method 'Range' of object '_Worksheet' failed** Next i Exit Sub Else targetSheet.Range("A(t)").Value = sourceSheet.Range("A(s)").Value ' xfer Part # targetSheet.Range("D(t)").Value = sourceSheet.Range("M(s)").Value ' xfer Order Qty End If t = t + 1 s = s + 1 Next i ' Close Customer(Source) workbook[/COLOR] customerWorkbook.Close End Sub 相信我解决了这个问题，我想做它。 仍在testing，但到目前为止，下面是通过源读取，同时确定源“订购数量”是否为空，并继续前进，直到源“订购数量”已inputamt，并分别导入相应的部件号和订购数量另一个。 它也通过或考虑由于订单数量字段有空白而可能已被过滤掉的空白订单数量金额或行。 根据下面，如果任何人都可以帮助回答我在代码的评论中留下的错误，同时尝试使用源的不同范围，将不胜感激。 Tia，khleisure
Private Sub ImportExternalDataToOrderForm_Click() '*******Exit Sub - Used to disable command button till sub written ' Get customer workbook... Dim customerBook As Workbook Dim filter As String Dim caption As String Dim customerFilename As String Dim customerWorkbook As Workbook Dim targetWorkbook As Workbook ' Active workbook is the Target Workbook Set targetWorkbook = Application.ActiveWorkbook ' get the customer workbook to use as Source WorkBook filter = "XLS files (*.xls),*.xls" caption = "Please Select an input file " customerFilename = Application.GetOpenFilename(filter, , caption) Set customerWorkbook = Application.Workbooks.Open(customerFilename) ' Ranges vary in Source Workbook to Target Workbook but, applicable data to import to Order Form ' Import data from customer(source) to target workbook(active Order Form) Dim targetSheet As Worksheet Set targetSheet = targetWorkbook.Worksheets(2) Dim sourceSheet As Worksheet Set sourceSheet = customerWorkbook.Worksheets(1) targetSheet.Range("B4").Value = sourceSheet.Range("C2").Value ' Works Great targetSheet.Range("B9").Value = sourceSheet.Range("C8").Value ' Works Great targetSheet.Range("G9").Value = sourceSheet.Range("C9").Value 'Works Great targetSheet.Range("N4:N6").Value = sourceSheet.Range("N2:N4").Value ' Works Great targetSheet.Range("J18:J20").Value = sourceSheet.Range("K7:K9").Value ' Works Great ' below 2 lines work for fixed range and every line regardless if filtered ' and regardless if Order Qty is blank 'targetSheet.Range("A27:A527").Value = sourceSheet.Range("A13:A513").Value 'targetSheet.Range("D27:D527").Value = sourceSheet.Range("M13:M513").Value '***** LOOP THOUGH PRODUCT AND QTY ORDERED DATA FOR BALANCE OF IMPORT ' Need to Loop through all Rows of overall Source (Starting R#13) to account ' for filtered lines that exist between the lines that remain and have a qty ' in the Order Qty Field (Col M). If Qty Ordered Blank (filtered) you pass up ' the import of Source A & M to Target A & D and move to next. If Qty Ordered from ' Source has a Qty entered, you drop through to import accordingly from Source to ' to Target. Set Currently at Max Source of Range A13:A3000 (Can increase if ' necessary. Also, counter to limit the number of imports to max 501 per Order ' Form's limit of lines currently. Have to modify Order Form and loop below if more Dim t As Long Dim s As Long Dim r As Long 'Dim rcount As Long (removed due to error below) '***** t = 27 ' Target Starting Row to accept imported data s = 13 ' Source Starting Row to begin import consideration r = 13 ' Define Start counter in For/Next below ' with Max set to 3000 potential rows currently (can increase if necessary) 'rcount = Workbook(sourceSheet).Cells(RowCount, "a").End(xlUp).Row ' error here 'rcount = customerWorkbook.Worksheets(1).Cells(RowCount, "a").End(xlUp).Row 'Above Line creates Error 1004 Application-defined or Object-defined Error ' For r = r to rcount Step 1 (removed because of above error) For r = r To 3000 Step 1 If t <= 527 Then ' 501 max occurrences that can import data "t" starts at 27 If sourceSheet.Range("M" & s).Value = "" Then If r = 3000 Then customerWorkbook.Close Exit Sub End If s = s + 1 Else targetSheet.Range("A" & t).Value = sourceSheet.Range("A" & s).Value targetSheet.Range("D" & t).Value = sourceSheet.Range("M" & s).Value t = t + 1 s = s + 1 End If Else customerWorkbook.Close Exit Sub End If Next r ' Close customer workbook customerWorkbook.Close End Sub