1

我一直在寻找一种方法来从“JDH”转换以下答案中的“优秀答案”（VBA 代码）。（我觉得尝试直接联系以获取以下答案的进一步帮助是不合适的）

下面的响应/答案中的 VBA 答案对于我需要的东西来说是 90% 的完美，除非我在源工作簿中阅读了我的 Part# 和 Order Qty 的数据（源可能是多达 5000 行产品并且已经过滤以隐藏具有空白订单数量的行），下面的 VBA 将复制范围内的所有数据，无论它是否被过滤。

（以下是我需要的 90+%） https://stackoverflow.com/a/7878070/1413702

我已经修改了代码以适用于我的实例，并且一切正常，直到我不得不阅读不为空白的 Part # & Order Qty 的数据。如果订单数量不是空白，我只想带上零件编号和订单数量，并意识到我可能需要通读 5000 行的整个范围以确保获得所有可能订购的物品。如果它是直接源范围到目标范围，那么上面将是完美的，但是，由于源可能已被过滤，因此范围内有隐藏的行需要检查订单数量空白。此外，此时可能发生的导入次数有一个总体限制，因为订单表仅设置为最多 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
4

1 回答 1

0

相信我已经解决了我想要它做的事情。仍在测试，但到目前为止，以下内容正在阅读源，同时确定源“订单数量”是否为空白并继续前进，直到源“订单数量”输入了一个 amt 并分别导入相应的零件编号和订购数量另一个。它还通过或考虑由于订单数量字段为空白而可能已在源上过滤掉的空白订单数量金额或行。如下所述，如果有人可以帮助回答我在尝试对源代码使用不同范围时在代码注释中留下的错误，我们将不胜感激。蒂亚, 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
于 2012-05-24T23:45:07.613 回答