VBAファイリングアレイと列の作成

Question

既存のリストを2つの配列にキャプチャし、少なくとも$ 500を費やした顧客に費やした顧客名と金額の新しい配列を2つ作成する必要があります。これらの新しい配列が塗りつぶされた後、列DとEに書き込む必要があります。

したがって、列1はA3：A50に由来し、これは顧客名が で、列2は売上高がC3：50です顧客が購入する価格。

配列を並べ替えるコードの部分を書くのに問題があり、販売価格が500ドルを超えているかどうかを判断しています。誰かが私がどこに間違っているかを指摘できますか？

これは私がこれまで持っているものですが、それは動作しません：

Sub ProductSales() 
' These are inputs: the number of customers, the customer's name, 
' and the dollar amount of each sale. 
Dim nCustomers As Integer 
Dim namesData() As String 
Dim dollarsData() As Integer 

' The following are outputs: the customer name found over 500, and the number 
'of customer over 500 
Dim customerFound() As String 
Dim customerCount() As Integer 

' Variables used in finding if sale is over 500 
Dim isOver As Boolean 
Dim nFound As Integer 

' Counters. 
Dim i As Integer 
Dim j As Integer 

' Clear any old results in columns E to G. 
With wsData.Range("E2") 
    Range(.Offset(1, 0), .Offset(0, 2).End(xlDown)).ClearContents 
End With 

' Find number of customers in the data set, redimension the namesdata and 
' dollarsData arrays, and fill them with the data in columns A and C. 
With wsData.Range("A2") 
    nCustomers = Range(.Offset(1, 0), .End(xlDown)).Rows.Count 
    ReDim namesData(1 To nCustomers) 
    ReDim dollarsData(1 To nCustomers) 
    For i = 1 To nCustomers 
     namesData(i) = .Offset(i, 0).Value 
     dollarsData(i) = .Offset(i, 2).Value 
    Next 
End With 

' Initialize the number of names found to 0. 
nFound = 0 

' Loop through all sales. 
For i = 1 To nCustomers 

    ' Set the Boolean isOver to False, and change it to True only 
    ' if the sale is over 500 
    isOver = False 
    If nFound > 0 Then 
     ' Loop through all customer names already found and add to new list 
     ' and exit loop 
     For j = 1 To nFound 
      If dollarsData(i) > 500 Then 
       isOver = True 
       customerCount(j) = customerCount(j) + 1 
       Exit For 
      End If 
     Next 
    End If 

    If isOver Then 
     ' The current product code is a new one, so update the list of 
     ' codes found so far, and initialize the transactionsCount and dollarsTotal 
     ' values for this new product. 
     nFound = nFound + 1 
     ReDim Preserve customerFound(1 To nFound) 
     ReDim Preserve customerCount(1 To nFound) 
     customerCount(nFound) = namesData(i) 
     customerCount(nFound) = 1 

    End If 
Next 

' Place the results in columns E to G. 
For j = 1 To nFound 
    With wsData.Range("E2") 
     .Offset(j, 0).Value = customerFound(j) 
     .Offset(j, 1).Value = customerCount(j) 

    End With 
Next 

End Subの

Answer 1

エクセルVBAは、1行の配列にRangeを書くの偉大な能力を持っています。これは非常に迅速で、開発者が自分の繰り返しコードを書く必要がありません。アレイはVariantとして宣言され、構文は次のとおりです。

は

readArray = Range("A3:A50").Value2 

同じことがあなたのシートに配列を書き込みに適用されます。構文は次のとおりです。

Range("A3:A50").Value = writeArray 

このように、プロジェクトのこの部分では、2つの列を読み取るだけです。それらをループして目的の項目を見つけ出し、出力配列に値を設定します。この例では私が見つけたアイテムの各インデックスを格納し、サイズは、単にCollection.CountあるCollectionを使用しましたので、出力配列をディメンションする必要があります。

ハードコード以下のサンプルあなたの範囲の大きさが、それはあなた自身のコードを簡素化する方法のアイデアを与える必要があります。

Dim ws As Worksheet 
Dim namesData As Variant 
Dim dollarsData As Variant 
Dim output() As Variant 
Dim foundIndexes As Collection 
Dim i As Long 
Dim v As Variant 

'Set the worksheet object 
Set ws = ThisWorkbook.Worksheets("Sheet1") 'change to your sheet name 

'Read the data 
With ws.Range("A3:A50") 
    namesData = .Value2 
    dollarsData = .Offset(, 2).Value2 
End With 

'Find the target customers 
Set foundIndexes = New Collection 
For i = 1 To UBound(dollarsData, 1) 
    If dollarsData(i, 1) > 500 Then 
     foundIndexes.Add i 
    End If 
Next 

'Size the output array 
ReDim output(1 To foundIndexes.Count, 1 To 2) 

'Populate the output array 
i = 1 
For Each v In foundIndexes 
    output(i, 1) = namesData(v, 1) 
    output(i, 2) = dollarsData(v, 1) 
    i = i + 1 
Next 

'Write array to sheet 
ws.Range("D3").Resize(UBound(output, 1), UBound(output, 2)).Value = output 

Answer 2

を私はあなたの実際の目標

は何かなりよく分からないけどあなたはこの

Option Explicit 

Sub ProductSales() 
Dim nCustomers As Integer ' inputs: the number of customers 
Dim namesData As Variant, dollarsData As Variant 'inputs: the customer's name, and the dollar amount of each sale 
Dim customerFound As Variant, customerDollarsFound As Variant 'ouputs: the customer name found over 500, and their corresponding dollars 
Dim firstValueIndex As Long ' index for the first dollar value > 500 in sorted column, if any 

With Worksheets("wsData") 

    .Range("E3:G" & .Cells(.Rows.Count, "E").End(xlUp).Row).ClearContents '<~~ clear previous results 

    With .Range("A1:A" & .Cells(.Rows.Count, 1).End(xlUp).Row) '<~~ consider column A values down to its last non empty cell 
     .Resize(, 3).Sort key1:=.Cells(1, 3), Order1:=xlDescending, Header:=xlYes '<~~ sort it by dollar amount in ascending order 
     With .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row) '<~~ consider column A form range A2 to down to its last non empty cell, which could be now different since sort has shifted blank cells to the range end 
      namesData = Application.Transpose(.Value) '<~~ fill first array 
      dollarsData = Application.Transpose(.Offset(, 2).Value) '<~~fill 2nd array 
      If GetFirstIndex(.Offset(, 2).Cells, 501, firstValueIndex) Then '<~~ if there's any value > 500 in column "C" (i.e. two columns right of "A") ... 
       customerFound = Application.Transpose(.Resize(firstValueIndex).Value) '<~~ ... then fill first output array... 
       customerDollarsFound = Application.Transpose(.Resize(firstValueIndex).Offset(, 2).Value) '<~~ ... and second output array 
      End If 
     End With 
    End With 

    If firstValueIndex > 0 Then '<~~ if output arrays have values... 
     .Range("E3").Resize(firstValueIndex).Value = Application.Transpose(customerFound) '<~~ ... then fill output range for names... 
     .Range("F3").Resize(firstValueIndex).Value = Application.Transpose(customerDollarsFound) '<~~ and fill output range for dollars 
    End If 

End With 

End Sub 

Function GetFirstIndex(rng As Range, minVal As Double, firstIndex As Long) As Boolean 
    On Error Resume Next 
    firstIndex = WorksheetFunction.Match(minVal, rng, -1) 
    GetFirstIndex = firstIndex > 0 
End Function