Главная Вход в систему Регистрация
Задать вопрос Консультации Пользователи Форум
О системе Помощь
Задать вопрос экспертам
Консультация № 139929
14.07.2008, 05:02
0.00 руб.
0 6 1
Компьютеры Программирование
Здравствуйте уважаемые эксперты!
Подскажите, пожалуйста, начинающему программировать в VBA.
У меня есть таблица с данными, которые записываются непериодически
с шагом примерно около 10 сек от 00:00:00 до 23:59:59. Шаг записи неустойчив и постоянно меняется. Мне необходимо сделать выборку по получасовым значениям и записать их на другой лист в столбец по временным интервалам 00:00-00:30, 00:30-01:00, 01:00-01:30....23:30-00:00.
Тип таблицы такой:
дата время значения
1 05.07.2008 23:59:57 6,15
2 06.07.2008 0:00:18 6,14
3 06.07.2008 0:01:48 6,15
4 06.07.2008 0:01:58 6,14
5 06.07.2008 0:02:38 6,15
6 06.07.2008 0:04:09 6,15
7 06.07.2008 0:04:49 6,15
8 06.07.2008 0:04:59 6,15
9 06.07.2008 0:05:19 6,15
10 06.07.2008 0:07:00 6,15
11 06.07.2008 0:07:10 6,15
12 06.07.2008 0:08:00 6,15
13 06.07.2008 0:09:00 6,15
14 06.07.2008 0:09:10 6,15
15 06.07.2008 0:09:41 6,15
16 06.07.2008 0:10:01 6,15
. . . .
. . . .
. . . .
2132 06.07.2008 23:50:01 6,07
2133 06.07.2008 23:50:31 6,07
2134 06.07.2008 23:51:52 6,07
2135 06.07.2008 23:52:42 6,07
2136 06.07.2008 23:53:52 6,07
2137 06.07.2008 23:54:02 6,07
2138 06.07.2008 23:55:33 6,07
2139 06.07.2008 23:56:33 6,07
2140 06.07.2008 23:57:43 6,07
2141 06.07.2008 23:58:44 6,07
2142 06.07.2008 23:59:44 6,07
2143 07.07.2008 0:00:15 6,07
Написал код, он у меня при отладке выдает ошибку(1004) на
строке VrmStr = Cells(L, 4).Value ???
Помогите разобраться,очень Вас прошу, мне негде даже проконсультироваться.
От этого сейчас во многом зависит моя работа..
--
С уважением,
Вадим Солоненко
vvs@lutek.ru

Приложение:
Sub tank_otchet() Dim TD As String Dim VrmStr As Date Dim DatStr As Double Dim SumDat As Double Dim AverSum As Double Dim N As Integer Dim L As Integer Dim K As Integer Dim A As Integer Dim S As Integer S = 4 N = 5 L = 5‘Application.ScreenUpdating = False DV = Date - 1 GD = Mid(DV, 9, 2) MS = Mid(DV, 4, 2) DN = Mid(DV, 1, 2) YD = (GD & "." & MS & "." & DN & "." & "xls") TD = "C:\Arhivs" & YD Workbooks.Open Filename:=TD Range("B4:E2200").Select Selection.Copy Windows("tank.xls").Activate Sheets("Лист1").Select ActiveSheet.Paste Range("B5").Select Do While Cells(N, 2) <> "" For I = 0 To 23Do VrmStr = Cells(L, 4).Value ‘ время DatStr = Cells(L, 5).Value ‘датаCall ParsStrIf ((DecMin = 0 And I <> 0 And FH <= 3) Or (DecMin = 3 And FH <= 3)) And (A > 30) Then ‘ шаблон выборки 30 мин AverSum = SumDat / A ‘считаю среднее значение SumDat = 0 ‘ обнуляю для нового счета A = 0 ‘ шаг Sheets("Лист2").Select Cells(S, 4).Value = AverSum ‘записываю данные S = S + 1Else SumDat = SumDat + DatStr A = A + 1 N = N + 1 L = L + 1 End IfLoop Until I <> TimeSP Next ILoop ‘Обработка временного интервалаSub ParsStr() Dim TimeZ As String Dim T_Min As String Dim F_Half As String Dim TimeSP As Integer Dim DecMin As Integer Dim FH As Integer LStr = Len(VrmStr)If LStr <> 8 Then TimeZ = Left(VrmStr, 1) ‘ для 0-9 T_Min = Mid(VrmStr, 3, 1) ‘ для 10-23 F_Half = Mid(VrmStr, 4, 1) ‘ флаг предела получасовокElse TimeZ = Left(VrmStr, 2) ‘ выборка 2-х левых символов T_Min = Mid(VrmStr, 4, 1) ‘ выборка 1-го сред-го символа F_Half = Mid(VrmStr, 5, 1) ‘ флаг получасовки End If TimeSP = Val(TimeZ) ‘ цифры DecMin = Val(T_Min) ‘ FH = Val(F_Half) ‘End Sub‘Application.ScreenUpdating = TrueEnd Sub

Обсуждение

давно
PsySex
Профессионал
848
1596
14.07.2008, 10:28
общий
Попробуйте изменить тип переменной L на LONG. Вообще желательно пользоваться типами LONG для целочисленных переменных, нежели INTEGER.
Неизвестный
14.07.2008, 21:10
общий
это ответ
Здравствуйте, Солоненко Вадим Владимирович!
В приложении код на базе которого Вы сможете создать конструкцию для выполнения этой задачи.
Евгений.

Приложение:
Sub tank_otchet()Const sPath$ = "C:\Arhivs", sExt$ = ".xls", sHalfHour$ = "30", sWholeHour = "00"Const sNameFormat$ = "YY.MM.DD", sMinutFormat$ = "mm", sEmpty$ = ""Dim TD$, vVar, s$, bHalf As Boolean, iRtarg%Dim iRow&, xSour As Object, xTarg As Object‘Application.ScreenUpdating = FalseSet xTarg = ActiveWorkbook.Sheets(1) ‘активный лист будет целевымTD = sPath & Format(Date - 1, sNameFormat) & sExt ‘Workbooks.Open Filename:=TD ‘конструкция открытия рабочей книгиSet xSour = ActiveWorkbook.Sheets(1) ‘первый лист открытой книгиiRtarg = iRtarg ‘начальная строка целевого листаFor iRow = 5 To lastRow(xSour) ‘перебор строк vVar = xSour.Cells(iRow, 4).Value ‘инициализация переменной If IsDate(vVar) Then ‘если переменная содержит дату s = Format(vVar, sMinutFormat) ‘присваиваем s значение минут If s = sHalfHour And Not bHalf Then ‘получасовой "триггер" bHalf = True ElseIf s = sWholeHour And bHalf Then ‘ bHalf = False Else ‘ s = sEmpty End If If Len(s) > 0 Then iRtarg = iRtarg + 1 ‘..... xTarg.Cells(iRtarg, 4) = vVar ‘........ xTarg.Cells(iRtarg, 5) = xSour.Cells(iRow, 5).Value ‘...... End If End IfNext‘Application.ScreenUpdating = TrueEnd SubPrivate Function lastRow(oSheet As Sheets) As Long ‘функция возвращает номер последней занятой строки lastRow = oSheet.UsedRange.Rows.Count + oSheet.UsedRange.Row - 1End Function
Неизвестный
15.07.2008, 13:25
общий
Переменные я поменял на LONG при прогонке кода- на них указал отладчик.Проблема осталась с временными ячейками (вид 00:00:00) - они не присваиваются переменной любого типа- в переменной "Empty"...
давно
PsySex
Профессионал
848
1596
15.07.2008, 16:17
общий
я предположил сначала. что много строк и получается переполнение переменной L - почему и предложил изменить ее тип.Так ответ Тесленко Евгений Алексеевича вам не помог??? Проблема осталась?
Неизвестный
16.07.2008, 02:05
общий
Евгений Алексеевич код подкорректировал- на данный момент должен быть работоспособным, буду разбираться..
Неизвестный
16.07.2008, 09:06
общий
Большое спасибо всем, кто остался небезучастным в решении моей проблемы - программа заработала. Тема считаю закрытой .
Форма ответа