Question

我有以下电子表格结构。

ID, Storage_name, Name_of_product, Quantity_used, Date_Used

用户提供开始日期和结束日期，我必须在这些开始/结束日期之间填充存储中存在的所有产品的使用数量。

例如

如果结构是

ID   Storage_name   Name_of_Product    Quantity used    Date_used

 1       st1           pro1                2              11/1/2011
 2       st2           pro2                5              11/2/2011
 1       st1           pro1                3              11/2/2011
 4       st1           pro3                5              11/4/2011

并且用户选择st1作为存储位置，并选择11/01/2011和11/04/2011作为我的输出的开始和结束日期

ID   Storage_name   Name_of_Product    Quantity used    

1     st1              pro1                 7
4     st1              pro3                 5

我没有使用数据库（我希望我是）。这是最好的方法。

我首先从头到尾运行三个循环，第二个检查storage_name，第三个检查Name_of_product然后更新quantity_counter但它变得凌乱。应该有更好的方法来做到这一点。我正在将输出写入文件。

由于 P.S我知道我不必在输出文件中使用列storage_name。无论哪种方式都没问题。

我这样做

Dim quantity as long 
storageName= selectWarehouse.Value  ' from combo box
quantity = 0

With Worksheets("Reports")
 lastrow = .Range("A1").SpecialCells(xlCellTypeLastCell).row + 1
End With

row = 2
 While (row < lastrow)
  If CStr((Worksheets("Reports").Cells(row, 2))) = storageName Then
    name = CStr((Worksheets("Reports").Cells(row, 3)))
    quantity = quantity + CLng(Worksheets("Reports").Cells(row, 4))
  End If
  row = row + 1
 Wend

我在开始时检查日期。那部分没问题。

Answer 1

你可以使用字典。这是一些可以帮助你入门的伪代码。

Start
  If range = storageName then
    if within the date range then
        If not dictionary.exists(storageName) then dictionary.add storageName
        dictionary(storageName) =     dictionary(storageName) + quantity
Loop

现在你只需要遍历细胞一次。

Answer 2

您可以将SQL与ADO和Excel一起使用

Dim cn As Object
Dim rs As Object
Dim strFile As String
Dim strCon As String
Dim strSQL As String
Dim s As String
Dim i As Integer, j As Integer

''This is not the best way to refer to the workbook
''you want, but it is very convenient for notes
''It is probably best to use the name of the workbook.

strFile = ActiveWorkbook.FullName

''Note that if HDR=No, F1,F2 etc are used for column names,
''if HDR=Yes, the names in the first row of the range
''can be used. 
''
''This is the Jet 4 connection string, you can get more
''here : http://www.connectionstrings.com/excel

strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
    & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"

''Late binding, so no reference is needed

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open strCon

''Some rough notes on input
sName = [A1]
dteStart = [A2]
dteEnd = [A3]

''Jet / ACE SQL
strSQL = "SELECT ID, Storage_name, Name_of_Product, Sum([Quantity used]) " _
       & "FROM [Report$] a " _
       & "WHERE Storage_name ='" & sName _
       & "' AND Date_Used Between #" & Format(dteStart, "yyyy/mm/dd") _
       & "# And  #" & Format(dteEnd, "yyyy/mm/dd") _
       & "# GROUP BY ID, Storage_name, Name_of_Product"

rs.Open strSQL, cn, 3, 3

''Pick a suitable empty worksheet for the results

Worksheets("Sheet3")
   For i = 0 To rs.Field.Count
       .Cells(1, i+1) = rs.Fields(i).Name
   Next 

   .Cells(2, 1).CopyFromRecordset rs
End With

''Tidy up
rs.Close
Set rs=Nothing
cn.Close
Set cn=Nothing

Answer 3

我没有测试下面的代码，但是这样的东西应该适合你。另外，我有一个dictionary object的引用，但你也可以迟到它。

Public Sub FilterTest(ByVal sStorageName As String, ByVal dDate1 As Double, ByVal dDate2 As Double)

    Dim dicItems As Dictionary
    Dim i As Long, lRowEnd As Long, lItem As Long
    Dim rData As Range, rResults As Range
    Dim saResults() As String
    Dim vData As Variant
    Dim wks As Worksheet, wksTarget As Worksheet

    'Get worksheet object, last row in column A, data
    Set wksTarget = Worksheets("Target")
    Set wks = Worksheets("Reports")
    lRowEnd = wks.Range(Rows.Count).End(xlUp).Row
    Set rData = wks.Range(wks.Cells(1, 1), wks.Cells(lRowEnd, ColumnNames.ColumnEnd))
    'Place data in 2D array
    vData = rData

    'Loop through data and gather correct data in dictionary
    Set dicItems = New Dictionary
    ReDim saResults(1 To 10, 1 To 4)
    For i = 1 To lRowEnd
        If vData(i, ColumnNames.Storage_name + 1) = sStorageName Then
            If vData(i, ColumnNames.Date_used + 1) >= dDate1 And vData(i, ColumnNames.Date_used + 1) <= dDate2 Then
                If dicItems.Exists(vData(i, ColumnNames.Name_of_Product + 1)) Then
                    'Determin location in array
                    lItem = dicItems(vData(i, ColumnNames.Name_of_Product + 1))
                    'Add new value to array
                    saResults(dicItems.Count + 1, 4) = CStr(CDbl(saResults(dicItems.Count + 1, 4)) + CDbl(vData(i, ColumnNames.Quantity_used + 1)))
                Else
                    'If new add new item to results string array
                    saResults(dicItems.Count + 1, 1) = CStr(vData(i, ColumnNames.ID + 1))
                    saResults(dicItems.Count + 1, 2) = CStr(vData(i, ColumnNames.Storage_name + 1))
                    saResults(dicItems.Count + 1, 3) = CStr(vData(i, ColumnNames.Name_of_Product + 1))
                    saResults(dicItems.Count + 1, 4) = CStr(vData(i, ColumnNames.Quantity_used + 1))
                    'Add location in array
                    dicItems.Add vData(i, ColumnNames.Name_of_Product + 1), dicItems.Count + 1
                End If
            End If
        End If
    Next i
    ReDim Preserve saResults(1 To dicItems.Count, 1 To 4)

    'Print Results to target worksheet
    With wksTarget
        Set rResults = .Range(.Cells(1, 1), .Cells(dicItems.Count, 4))
        rResults = saResults
    End With

End Sub

填充VBA的最佳方式

3 个答案: