VBA를 채우는 가장 좋은 방법

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 

이고, 사용자가 저장 위치와 같은 개시와 2011년 11월 1일 2011년 11월 4일 내 출력해야 종료일 등 ST1 선택되면 be

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

당신은 당신의 코드처럼 보이는 무슨 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 2

사전을 사용할 수 있습니다. 다음은 시작할 수있는 의사 코드입니다.

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 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