ms041270 |
Дата: Понедельник, 06.04.2020, 11:13 |
Сообщение № 1 |
|
Группа: Пользователи
Ранг: Новичок
Сообщений: 12
Репутация:
0
±
Замечаний:
0% ±
 Excel 2010 | |
Добрый день.
Есть макрос отбора данных из массива по дате и формирование на другом листе списка этих данных.
Sub Sampling_by_date()
Dim arr()
Dim iStr
Dim iDate, myDate
With Worksheets("tabl_maintenance_day")
arr = .Range("A3:L" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
End With
ReDim arrSampl(1 To UBound(arr), 1 To 23)
With Worksheets("input_data_maintenance")
iDate = CDbl(DateSerial(Val(.Range("D32").Value), Val(.Range("D31").Value), Val(.Range("D30").Value)))
End With
'-----------------------------------------------------------
For I = LBound(arr) To UBound(arr)
iStr = Split(Trim(arr(I, 1)), ".")
myDate = CDbl(DateSerial(Val(iStr(2)), Val(iStr(1)), Val(iStr(0))))
If myDate = iDate Then
N = N + 1
arrSampl(N, 1) = arr(I, 2): arrSampl(N, 2) = arr(I, 3)
arrSampl(N, 3) = arr(I, 4): arrSampl(N, 16) = arr(I, 5)
arrSampl(N, 17) = arr(I, 6): arrSampl(N, 18) = arr(I, 7)
arrSampl(N, 20) = arr(I, 9): arrSampl(N, 21) = arr(I, 10)
arrSampl(N, 19) = arr(I, 8): arrSampl(N, 22) = arr(I, 11)
End If
Next
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
With Worksheets("print_form")
lRow = .Cells(.Rows.Count, "A").End(xlUp).Row
lRow = IIf(lRow < 4, 4, lRow)
.Range("A4:W" & lRow).ClearContents
.Range("A4").Resize(N, 23) = arrSampl
End With
Worksheets("print_form").Activate
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Данный макрос был написан и РАБОТАЕТ на одном компе (Exsel 2007, русская версия), а на другом (Exsel 2019, англоязычная версия) НЕ РАБОТАЕТ.
Выдает ошибку в строке
myDate = CDbl(DateSerial(Val(iStr(2)), Val(iStr(1)), Val(iStr(0))))
Подскажите, за что отвечает и как работает эта конкретная строчка (где найти ошибку) и за что отвечает каждая из строк данного макроса.
Большое спасибо.
Добрый день.
Есть макрос отбора данных из массива по дате и формирование на другом листе списка этих данных.
Sub Sampling_by_date()
Dim arr()
Dim iStr
Dim iDate, myDate
With Worksheets("tabl_maintenance_day")
arr = .Range("A3:L" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
End With
ReDim arrSampl(1 To UBound(arr), 1 To 23)
With Worksheets("input_data_maintenance")
iDate = CDbl(DateSerial(Val(.Range("D32").Value), Val(.Range("D31").Value), Val(.Range("D30").Value)))
End With
'-----------------------------------------------------------
For I = LBound(arr) To UBound(arr)
iStr = Split(Trim(arr(I, 1)), ".")
myDate = CDbl(DateSerial(Val(iStr(2)), Val(iStr(1)), Val(iStr(0))))
If myDate = iDate Then
N = N + 1
arrSampl(N, 1) = arr(I, 2): arrSampl(N, 2) = arr(I, 3)
arrSampl(N, 3) = arr(I, 4): arrSampl(N, 16) = arr(I, 5)
arrSampl(N, 17) = arr(I, 6): arrSampl(N, 18) = arr(I, 7)
arrSampl(N, 20) = arr(I, 9): arrSampl(N, 21) = arr(I, 10)
arrSampl(N, 19) = arr(I, 8): arrSampl(N, 22) = arr(I, 11)
End If
Next
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
With Worksheets("print_form")
lRow = .Cells(.Rows.Count, "A").End(xlUp).Row
lRow = IIf(lRow < 4, 4, lRow)
.Range("A4:W" & lRow).ClearContents
.Range("A4").Resize(N, 23) = arrSampl
End With
Worksheets("print_form").Activate
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Данный макрос был написан и РАБОТАЕТ на одном компе (Exsel 2007, русская версия), а на другом (Exsel 2019, англоязычная версия) НЕ РАБОТАЕТ.
Выдает ошибку в строке
myDate = CDbl(DateSerial(Val(iStr(2)), Val(iStr(1)), Val(iStr(0))))
Подскажите, за что отвечает и как работает эта конкретная строчка (где найти ошибку) и за что отвечает каждая из строк данного макроса.
Большое спасибо.ms041270
Сообщение отредактировал ms041270 - Понедельник, 06.04.2020, 11:41 |
|
| Ответить
|
RAN |
Дата: Понедельник, 06.04.2020, 13:08 |
Сообщение № 2 |
|
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
| |
Эта строчка отвечает за преобразование данных, которое в различных локалях нужно выполнять по разному.
Эта строчка отвечает за преобразование данных, которое в различных локалях нужно выполнять по разному.RAN
Быть или не быть, вот в чем загвоздка!
|
|
| Ответить
|
doober |
Дата: Понедельник, 06.04.2020, 15:24 |
Сообщение № 3 |
|
Группа: Друзья
Ранг: Ветеран
Сообщений: 993
Репутация:
345
±
Замечаний:
0% ±
 Excel 2010 | |
уберите CDbl Назначьте для iDate, myDate тип данных Date
уберите CDbl Назначьте для iDate, myDate тип данных Datedoober
Сообщение отредактировал doober - Понедельник, 06.04.2020, 15:26 |
|
| Ответить
|
ms041270 |
Дата: Понедельник, 06.04.2020, 16:17 |
Сообщение № 4 |
|
Группа: Пользователи
Ранг: Новичок
Сообщений: 12
Репутация:
0
±
Замечаний:
0% ±
 Excel 2010 | |
RAN БОЛЬШОЕ спасибо!!!
|
|
| Ответить
|
ms041270 |
Дата: Понедельник, 06.04.2020, 16:18 |
Сообщение № 5 |
|
Группа: Пользователи
Ранг: Новичок
Сообщений: 12
Репутация:
0
±
Замечаний:
0% ±
 Excel 2010 | |
doober, БОЛЬШОЕ спасибо!!!
|
|
| Ответить
|