Лучший из возможных способов заселения VBA - PullRequest
Новая
       34

Лучший из возможных способов заселения VBA

1 голос
/ 02 декабря 2011

У меня следующая структура электронной таблицы. 

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 в качестве места хранения, а 01.11.2011 и 11.04.2011 в качестве даты начала и окончания мой вывод должен быть 

ID   Storage_name   Name_of_Product    Quantity used    

1     st1              pro1                 7
4     st1              pro3                 5

Я не использую базы данных (хотелось бы). Какой самый лучший способ сделать это.

Я запускаю три цикла: сначала от начала до конца, затем проверяю имя_хранилища, третье проверяю_продукт__изображения и затем обновляю количество_счетчиков, но оно становится грязным. должен быть лучший способ сделать это. Я записываю вывод в файл.

Спасибо 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

Я проверяю дату в начале. Эта часть в порядке.

Ответы [ 3 ]

2 голосов
/ 02 декабря 2011

Вы можете использовать словарь. Вот некоторый псевдокод, который поможет вам начать работу. 

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

Теперь вам нужно пройти через ячейки только один раз.

1 голос
/ 02 декабря 2011

Вы можете использовать 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
0 голосов
/ 02 декабря 2011

Я не тестировал приведенный ниже код, но что-то вроде этого должно работать для вас.Кроме того, у меня есть ссылка на 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
...