-Музыка

 -Подписка по e-mail

 

 -Поиск по дневнику

Поиск сообщений в fixin

 -Сообщества

 -Статистика

Статистика LiveInternet.ru: показано количество хитов и посетителей
Создан: 12.12.2002
Записей: 4343
Комментариев: 24598
Написано: 35607


Макросы в баб-листе

Воскресенье, 03 Февраля 2008 г. 23:31 + в цитатник
Короче, поднапрягся я на выхах и вставил в баб-лист макрос, который мне на отдельный лист выкидывает по датам виды активности - в таком виде по конкретному контакту удобно смотреть историю. ;-)
Ну и подстчитывать число встреч например за месяц тоже удобно.

Вот макрос:

Sub Протокол()
Set SrcSheet = Sheets("Протокол")
Set DstSheet = Sheets("Data")
pos = 0
'DstSheet.Range(DstSheet.Cells(1, 2), DstSheet.Cells(1, 20000)).ClearContents


With SrcSheet
For i = 4 To 1000
ContactCode = .Cells(i, 1).Value
If ContactCode = "" Then
Exit For
End If
ContactName = .Cells(i, 2).Value
If i Mod 10 = 0 Then
DoEvents
End If
For j = 22 To 100
ActivityCode = .Cells(i, j).Value
If ActivityCode <> "" Then
ActivityDate = .Cells(3, j).Value
ActivityMsg = ""
On Error Resume Next
ActivityMsg = .Cells(i, j).Comment.Text
On Error GoTo 0
'Debug.Print ActivityDate, ActivityCode, ActivityMsg
WritePos = pos + 2
DstSheet.Cells(WritePos, 1).Value = ContactCode
DstSheet.Cells(WritePos, 3).Value = ActivityDate
DstSheet.Cells(WritePos, 4).Value = ActivityCode
DstSheet.Cells(WritePos, 5).Value = ActivityMsg
pos = pos + 1
End If
Next
Application.StatusBar = i & " " & " " & ContactCode & " " & ContactName
Next
End With
MsgBox "Протокол перенесен в список на странице DATA. OK."
End Sub

LI 7.05.22 beta

ФУ_ФИКСА_С_ДРУГОМ   обратиться по имени Вторник, 12 Февраля 2008 г. 10:04 (ссылка)
СМЕРТЬ ПИДАРАСАМ!!!
ГОЛУБАЯ ЭКСПАНСИЯ ПИНДОСОВ НЕ ПРОЙДЕТ!!!
БЕЙ ГНИДОФИКСИНОВ, СПАСАЙ РОССИЮ!!!
СКАЖИ ПИДАРАМ НЕТ!!!

РОБОТЫ РУЛЯТ!!! ФИКСА ЖРИ ГАВНО!!!
:))))))))))))))))))))))
ЗАЕБЕШЬСЯ БАНИТЬ! ГАВНОМЕТ СНОВА В СТРОЮ, ОТКРЫВАЙ РОТ ПОШИРЕ ГАМАСЯТИНА
Ответить С цитатой В цитатник
 

Добавить комментарий:
Текст комментария: смайлики

Проверка орфографии: (найти ошибки)

Прикрепить картинку:

 Переводить URL в ссылку
 Подписаться на комментарии
 Подписать картинку