Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Макрос отбора данных с переносом на другой лист - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос отбора данных с переносом на другой лист (Макросы/Sub)
Макрос отбора данных с переносом на другой лист
ms041270 Дата: Понедельник, 06.04.2020, 11:13 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 12
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Добрый день.

Есть макрос отбора данных из массива по дате и формирование на другом листе списка этих данных.

[vba]
Код
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
[/vba]

Данный макрос был написан и РАБОТАЕТ на одном компе (Exsel 2007, русская версия), а на другом (Exsel 2019, англоязычная версия) НЕ РАБОТАЕТ.

Выдает ошибку в строке [vba]
Код
myDate = CDbl(DateSerial(Val(iStr(2)), Val(iStr(1)), Val(iStr(0))))
[/vba]

Подскажите, за что отвечает и как работает эта конкретная строчка (где найти ошибку) и за что отвечает каждая из строк данного макроса.

Большое спасибо.


Сообщение отредактировал ms041270 - Понедельник, 06.04.2020, 11:41
 
Ответить
СообщениеДобрый день.

Есть макрос отбора данных из массива по дате и формирование на другом листе списка этих данных.

[vba]
Код
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
[/vba]

Данный макрос был написан и РАБОТАЕТ на одном компе (Exsel 2007, русская версия), а на другом (Exsel 2019, англоязычная версия) НЕ РАБОТАЕТ.

Выдает ошибку в строке [vba]
Код
myDate = CDbl(DateSerial(Val(iStr(2)), Val(iStr(1)), Val(iStr(0))))
[/vba]

Подскажите, за что отвечает и как работает эта конкретная строчка (где найти ошибку) и за что отвечает каждая из строк данного макроса.

Большое спасибо.

Автор - ms041270
Дата добавления - 06.04.2020 в 11:13
RAN Дата: Понедельник, 06.04.2020, 13:08 | Сообщение № 2
Группа: Друзья
Ранг: Участник клуба
Сообщений: 5335
Репутация: 1065 ±
Замечаний: 0% ±

2010
Эта строчка отвечает за преобразование данных, которое в различных локалях нужно выполнять по разному.


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеЭта строчка отвечает за преобразование данных, которое в различных локалях нужно выполнять по разному.

Автор - RAN
Дата добавления - 06.04.2020 в 13:08
doober Дата: Понедельник, 06.04.2020, 15:24 | Сообщение № 3
Группа: Друзья
Ранг: Ветеран
Сообщений: 671
Репутация: 255 ±
Замечаний: 0% ±

Excel 2010
уберите CDbl
Назначьте для iDate, myDate тип данных Date




Сообщение отредактировал doober - Понедельник, 06.04.2020, 15:26
 
Ответить
Сообщениеуберите CDbl
Назначьте для iDate, myDate тип данных Date

Автор - doober
Дата добавления - 06.04.2020 в 15:24
ms041270 Дата: Понедельник, 06.04.2020, 16:17 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 12
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
RAN БОЛЬШОЕ спасибо!!!
 
Ответить
СообщениеRAN БОЛЬШОЕ спасибо!!!

Автор - ms041270
Дата добавления - 06.04.2020 в 16:17
ms041270 Дата: Понедельник, 06.04.2020, 16:18 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 12
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
doober, БОЛЬШОЕ спасибо!!!
 
Ответить
Сообщениеdoober, БОЛЬШОЕ спасибо!!!

Автор - ms041270
Дата добавления - 06.04.2020 в 16:18
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос отбора данных с переносом на другой лист (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

jooble Яндекс цитирования
© 2010-2020 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!