Форум продуктов IBM Lotus

Продукты IBM Lotus => IBM Lotus Notes & Domino => Тема начата: FL@$H от 06 Апрель 2011, 17:38:36

Название: как сделать список с двумя ключами или что-то вроде того
Отправлено: FL@$H от 06 Апрель 2011, 17:38:36

Здраствуйте. Не могу до конца разобраться с типами данных. Если кто может помочь, буду благодарен.
Собственно я хочу реализовать что-то типа списка с двумя ключами, но не знаю как.
Может, я не правильно подошел к решению задачи. Поэтому сформулирую её упрощенную версию.

Есть форма с полями на ней:
    f_task - тип задания,
    f_depart - отдел,
    f_mark - текст обработки документа.

Мне нужно реализовать отчет примерно следующего вида:
(http://i033.radikal.ru/1104/92/22fb9c487ad6.jpg)
Количество документов может доходить до нескольких тысяч.
Поэтому остро стоит необходимость, чтобы перебрать их все за один раз в цикле.
Собственно вопрос: как посчитать количество пришедших и обработанных документов для отчета.

Хотел сделать что-то типа такого:
income_count("task","depart");
marked_count("task","depart");

Потом проинизиализировать всё для каждого отдела и задания нулями и при переборе по мере выполнения условий сравнения добавлять значения к елементам списка. В итоге получил бы что-то типа:
income_count("1.1","1 отдел") = 5;
income_count("1.1","2 отдел") = 10;
...
marked_count("1.1","1 отдел") = 4 и т.д.

Как можно подобное реализовать?

Название: Re: как сделать список с двумя ключами или что-то вроде того
Отправлено: lotusnotes.ru от 12 Апрель 2011, 15:26:23

Можно так:
1. Делаю вьюху примерно такую:
Тип задания = Исполнитель = Обработано (1/0)
2. Агент на LS, который проходит по всем документам вида и формирует в Excel готовый отчет
он идет последовательно по документам , проверяет, изменились ли первые 2 столбца
если не изменились - увеличивает счетчики пришедших и обработанных документов в зависимости от 3 столбца
если изменились - выводит в excel строчку с набранными счетчикам, обнуляет их, дальше считает следующий отдел или тип задания
Пример:

Код: [Выделить]

Sub Initialize
Dim view As NotesView
Dim column As NotesViewColumn
Dim viewentries As NotesViewEntryCollection
Dim viewnav As NotesViewNavigator
Dim viewentry As NotesViewEntry
Dim session As NotesSession
Dim db As NotesDatabase
Dim dc As NotesDocumentCollection
Dim doc As NotesDocument
Dim curuser As String, curdate1 As NotesDateTime, curdate2 As NotesDateTime, curtype As String, curflag As Integer, curcount1 As Long, curcount2 As Long, curcount3 As Long, curcount4 As Long, curcount5 As Long, curcount6 As Long
Dim allcount1 As Long, allcount2 As Long, allcount3 As Long, allcount4 As Long, allcount5 As Long, allcount6 As Long
Dim date1 As NotesDateTime, date2 As NotesDateTime, inputdate1 As String, inputdate2 As String
Dim excelAppObject As Variant
Dim excelWorksheetObject As Variant
Dim excelLine As Long

On Error Goto processerror

Dim ws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Set uidoc = ws.CurrentDocument
Set date1 = New NotesDateTime(uidoc.FieldGetText("date1"))
Set date2 = New NotesDateTime(uidoc.FieldGetText("date2"))

Print "Создание объекта MS Excel"
Set excelAppObject = CreateObject("Excel.Application")
If excelAppObject Is Nothing Then
Msgbox "Невозможно создать объект Excel"
Exit Sub
End If

Print "Подготовка таблицы Excel"
excelAppObject.Visible = False
Call excelAppObject.Workbooks.Add
Set excelWorksheetObject = excelAppObject.ActiveSheet

'форматирование
excelWorksheetObject.Name = "Отчет по видам услуг"
excelWorksheetObject.Cells.Font.Size = 8
excelWorksheetObject.Rows("1:2").Select
excelAppObject.Selection.Font.Bold = True
excelAppObject.Selection.VerticalAlignment = -4108
excelAppObject.Selection.HorizontalAlignment = -4108
excelAppObject.Selection.WrapText = True
excelWorksheetObject.Cells.EntireColumn.Autofit

'заголовок
excelWorksheetObject.Range( "A1:A2").Select
excelAppObject.Selection.MergeCells = True
excelAppObject.Selection.Value = "Наименование"
excelWorksheetObject.Range( "B1:B2").Select
excelAppObject.Selection.MergeCells = True
excelAppObject.Selection.Value = "Всего"
excelWorksheetObject.Range( "C1:E1").Select
excelAppObject.Selection.MergeCells = True
excelAppObject.Selection.Value = "В том числе:"
excelWorksheetObject.Range( "C2").Value = "Услуга 1"
excelWorksheetObject.Range( "D2").Value = "Услуга 2"
excelWorksheetObject.Range( "E2").Value = "Услуга 3"

Print "Экспорт данных отчета"

Set session = New NotesSession
Set db = session.CurrentDatabase
Set view = db.GetView("(report7)")
Set viewentries = view.AllEntries
Set viewentry = viewentries.GetFirstEntry

curcount1 = 0
curcount2 = 0
curcount3 = 0
curcount4 = 0
allcount1 = 0
allcount2 = 0
allcount3 = 0
allcount4 = 0
curuser = ""
excelLine = 3
Set curdate1 = New NotesDateTime("")

While Not viewentry Is Nothing
If Not viewentry.ColumnValues(1) = "" Then
curdate1.LocalTime = viewentry.ColumnValues(1)
End If
If Not viewentry.ColumnValues(0) = curuser Then
If Not curuser="" Then
excelWorksheetObject.Range("A"&excelLine).Value = curuser
excelWorksheetObject.Range("B"&excelLine).Value = curcount1
excelWorksheetObject.Range("C"&excelLine).Value = curcount2
excelWorksheetObject.Range("D"&excelLine).Value = curcount3
excelWorksheetObject.Range("E"&excelLine).Value = curcount4
excelLine = excelLine+1
End If
curuser = viewentry.ColumnValues(0)
curcount1 = 0
curcount2 = 0
curcount3 = 0
curcount4 = 0
End If
If (Not viewentry.ColumnValues(1)="") Then
If curdate1.LSLocalTime>=date1.LSLocalTime And curdate1.LSLocalTime<=date2.LSLocalTime Then
curcount1=curcount1+1
allcount1=allcount1+1

If viewentry.ColumnValues(2)="Service1" Then
curcount2=curcount2+1
allcount2=allcount2+1
End If
If viewentry.ColumnValues(2)="Service2" Then
curcount3=curcount3+1
allcount3=allcount3+1
End If
If viewentry.ColumnValues(2)="Service3" Then
curcount4=curcount4+1
allcount4=allcount4+1
End If
End If

End If



Set viewentry = viewentries.GetNextEntry(viewentry)
Wend
excelWorksheetObject.Range("A"&excelLine).Value = curuser
excelWorksheetObject.Range("B"&excelLine).Value = curcount1
excelWorksheetObject.Range("C"&excelLine).Value = curcount2
excelWorksheetObject.Range("D"&excelLine).Value = curcount3
excelWorksheetObject.Range("E"&excelLine).Value = curcount4
excelLine = excelLine+1
excelWorksheetObject.Range("A"&excelLine).Value = "ИТОГО:"
excelWorksheetObject.Range("B"&excelLine).Value = allcount1
excelWorksheetObject.Range("C"&excelLine).Value = allcount2
excelWorksheetObject.Range("D"&excelLine).Value = allcount3
excelWorksheetObject.Range("E"&excelLine).Value = allcount4
excelWorksheetObject.Rows(excelLine & ":" & excelLine).Select
excelAppObject.Selection.Font.Bold = True

excelWorksheetObject.Columns("A:A").EntireColumn.AutoFit
excelWorksheetObject.Columns("B:B").EntireColumn.AutoFit
excelWorksheetObject.Columns("C:C").EntireColumn.AutoFit
excelWorksheetObject.Columns("D:D").EntireColumn.AutoFit
excelWorksheetObject.Columns("E:E").EntireColumn.AutoFit

excelWorksheetObject.Range("A1:E"&Cstr(excelLine)).Select
excelAppObject.Selection.Borders(5).LineStyle = -4142
excelAppObject.Selection.Borders(6).LineStyle = -4142
excelAppObject.Selection.Borders(7).LineStyle = 1
excelAppObject.Selection.Borders(8).LineStyle = 1
excelAppObject.Selection.Borders(9).LineStyle = 1
excelAppObject.Selection.Borders(10).LineStyle = 1
excelAppObject.Selection.Borders(11).LineStyle = 1
excelAppObject.Selection.Borders(12).LineStyle = 1

'return to cell A1 for tidyness
excelWorksheetObject.Range("A1").Select

excelAppObject.Visible = True

Exit Sub

processerror:
If Err = 208 Then
Messagebox "У вас нет установленного Microsoft Excel. "
Else
Messagebox "Ошибка! " & Error & " (" & Err & ")"
End If

Exit Sub
End Sub

разберетесь - сделаете любой по сложности отчет