填充VBA的最佳方式

我有以下电子表格结构。填充VBA的最佳方式

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

我检查的日期开始。那部分很好。

来源

2011-12-01 Ank

什么看起来像你的代码？ –

我将使用代码 – Ank

更新我的帖子“哪种方法是最好的方法” - 使用变量数组进行数据操作，然后将最终转储数据用于表单。 *从不*运行For循环来逐个转储信息单元格。我现在无法得到这个，如果可能的话周末会查看 – brettdj

您可以使用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

来源

2011-12-02 12:50:55 Fionnuala

我没有使用数据库.. – Ank

@Ankur看看连接字符串，它连接到Excel电子表格。您可以使用ADO将Excel中有组织的一组数据视为表格。另请参阅http://support.microsoft.com/kb/257819 – Fionnuala

这很酷。不知道这可以做到.. – Ank

您可以使用字典。这里有一些可以让你开始的伪代码。

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

现在你只需要遍历单元格一次。

来源

2011-12-01 23:33:00

字典是一个好主意..我不知道VBA有字典支持 – Ank

请务必将Dim作为对象然后Set = CreateObject（“scripting.dictionary”）使用。 – aevanko

如何访问我在字典中添加的密钥的值。我试图做我在Python做的事情，但它不工作..键=名称或产品价值=数量使用 – Ank

我没有测试下面的代码，但像这样的东西应该为你工作。另外，我参考了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

来源

2011-12-02 00:15:15 Jon49

填充VBA的最佳方式

回答

相关问题