如何修改現有的VBA，以便在從一個Worksheet導入到另一個Worksheet時傳遞空白值？

Question

我一直在尋找一種方法來轉換「JDH」中以下答案中的「優秀答案」（VBA代碼）。 （我不覺得這是適當的嘗試和直接聯繫，以進一步的幫助下面的答案）

在下面的答案/答案的VBA答案是90％完美的我需要的除了一旦我開始閱讀我的零件編號和源工作簿中的訂單數量的數據（源可能多達5000行產品，並且已經過濾以隱藏具有空白訂購數量的行），下面的VBA將複製範圍內的所有數據，無論它是否已過濾或不。

（下面是接近我所需要的90 +％） https://stackoverflow.com/a/7878070/1413702

我已經修改了代碼，爲我實例工作，一切都很正常，直到我到具有通過對零件編號的數據讀取&訂單數量不是空白。如果訂單數量不是空白的，我只想帶過零件編號和訂單數量，並且意識到我需要讀取5000行的全部範圍以確保獲取所有可能訂購的商品。如果它是一個直接指向範圍的源範圍，那麼上述內容將是完美的，因爲可能已經過濾了源代碼，所以需要檢查Order Qty Blank的範圍內的隱藏行。此外，此時可能出現的進口次數的總數有限，因爲訂單隻能設置爲最多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 

Answer 1

相信我解決了這個對我想要做的事。仍在測試，但到目前爲止，下面是通過源讀取，同時確定源「訂購數量」是否爲空，並繼續前進，直到源「訂購數量」已輸入amt，並分別導入相應的Part＃和有序數量另一個。它還會通過或考慮由於訂單數量字段具有空白而可能已過濾出的空白訂單數量金額或行。如下所示，如果有人可以幫助回答我在代碼的評論中留下的錯誤，同時嘗試使用Source的不同範圍，我們將不勝感激。 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