填充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的最佳方式

回答

相關問題