1

下記の「JDH」から「ExcellentAnswer」（VBAコード）を変換する方法を探していました。（以下の彼の答えについてさらに助けを求めるために直接連絡することは適切でないと感じました）

以下の回答/回答のVBA回答は、ソースワークブックの部品番号と注文数量のデータを読んだ後を除いて、必要なものに対して90％完璧です（ソースは最大5000行の製品であり、空白の注文数量の行を非表示にするためにフィルターダウンされた場合、以下のVBAは、フィルター処理されているかどうかに関係なく、範囲内のすべてのデータをコピーします。

（以下は私が必要とするものに90％以上近いです） https://stackoverflow.com/a/7878070/1413702

インスタンスで機能するようにコードを変更しました。空白ではない部品番号と注文数量のデータを読み通す必要があるまで、すべてがうまく機能します。注文数量が空白でない場合にのみ、部品番号と注文数量を持ち込みたいのですが、注文される可能性のあるすべてのアイテムを確実に入手するには、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

私がやりたかったことのためにこれを解決したと信じてください。まだテスト中ですが、これまでのところ、以下はソースの「注文数量」が空白かどうかを判断しながらソースを読み込んでおり、ソースの「注文数量」に金額が入力されるまで進み、対応する部品番号と注文数量をそれぞれインポートしていますお互い。また、空白の注文数量フィールドが原因でソースで除外された可能性のある空白の注文数量または行を通過または考慮します。以下のように、ソースにさまざまな範囲を使用しようとしているときにコードのコメントに残したエラーに誰かが答えるのを手伝ってくれるなら、それはありがたいです. ティア、クレジャー

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 に答える