Смешанные ссылки в коде при работе с датами (нужна подсказка)

@pvmail · Регистрация: 10.01.2018

Студворк — интернет-сервис помощи студентам

Добрый день.
Для написания части кода мне необходимо определиться с оптимальным вариантом записи пользовательской функции, учитывающей смешанные ссылки на ячейки с датами и используемые в формулах при выполнении расчетов.
Упрощенный пример, основанный на ссылках вида $ прилагается.
Интересует как это реализовать в виде кода макроса? Предполагается, что для работы с таблицей блоки будут "дублироваться" с корректировкой даты.
При расчетах разности дат в коде планируется использовать функцию DateDiff.
Спасибо.

@pvmail · 15.01.2019, 12:39 **[ТС]**

Может быть, как вариант, использовать lastColumn, lastRow

@pvmail · 20.01.2019, 14:52 **[ТС]**

Добрый день. Кое-что у меня получилось, но осталась часть кода которую я не могу привести в порядок.
Прошу помощи.
Прилагаю упрощённый пример, который передаёт суть.

При заполнении таблицы данными (корректном заполнении) и необходимости вычисления разницы между датами (DateDiff) и записи результата в ячейку "i1" функция Pvmail перестаёт работать. Хотя MsgBox dy отображает результат вычисления.
В чём может быть причина?

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
Option Explicit
 
Function Корректно(vybor As Range) As Boolean
Dim i&, arr()
  If WorksheetFunction.Count(vybor) > 0 Then
    arr = vybor.Value
    For i = 1 To UBound(arr, 2)
      If IsEmpty(arr(1, i)) Xor IsEmpty(arr(2, i)) Then Exit Function
    Next
    Корректно = True
  End If
End Function
    
 
 
Function Pvmail(r As Range) As Variant()
Dim v(), i&, j&
  ReDim v(1 To 2, 1 To 5)
  
'блок для работы с датами, примерно
Option Explicit
 
Function Корректно(vybor As Range) As Boolean
Dim i&, arr()
  If WorksheetFunction.Count(vybor) > 0 Then
    arr = vybor.Value
    For i = 1 To UBound(arr, 2)
      If IsEmpty(arr(1, i)) Xor IsEmpty(arr(2, i)) Then Exit Function
    Next
    Корректно = True
  End If
End Function
    
 
 
Function Pvmail(r As Range) As Variant()
Dim v(), i&, j&
  ReDim v(1 To 2, 1 To 5)
  
'блок для работы с датами, примерно
    Dim dt1, dt2 As Date
    Dim dy As Integer
    dt1 = Range("C1")
    dt2 = Range("N1")
    
'вывод результатов при корректности исходных данных
  If Корректно(r) Then
    v(1, 1) = "сумма"
    v(2, 1) = WorksheetFunction.Sum(r) 'например
    v(1, 2) = "среднее"
    v(2, 2) = WorksheetFunction.Average(r) 'например
    v(1, 3) = "счет"
    v(2, 3) = WorksheetFunction.Count(r) 'например
    v(1, 4) = "что-то"
    v(1, 5) = "что-то"
    v(2, 4) = "что-то"
    v(2, 5) = "что-то"
    
''''''''''''''интересует как сделать вывод результата в ячейку "i1"
   dy = DateDiff("d", dt1, dt2)
   MsgBox dy                        'для проверки, формула считает
   Range("i1") = dy
    
 
'вывод результатов при НЕкорректности исходных данных, для примера
  Else
    For i = 1 To UBound(v, 2)
      For j = 1 To UBound(v)
        v(j, i) = vbNullString
    Next j, i
    v(1, 1) = "данные"
  End If
  Pvmail = v
End Function

@Hugo121 · 20.01.2019, 16:57

Сообщение от pvmail

В чём может быть причина?

- в том, что функция листа не может "напрямую" изменять значения других ячеек.

Добавлено через 4 минуты
Скорректируйте например так:

Visual Basic
1
2
3
4
        'Range("i1") =  dy
        With Range("i1")
            .Replace IIf(Len(.Value), "*", ""), dy
        End With

@pvmail · 20.01.2019, 20:09 **[ТС]**

Hugo121,
Спасибо.
Работает. Попробую с более сложными конструкциями.

@Hugo121 · 20.01.2019, 20:38

Надёжнее и правильнее в Range("i1") прописать другую UDF, работающую аналогично с Pvmail, но выводящую только одно значение.

@pvmail · 20.01.2019, 22:27 **[ТС]**

Hugo121,
Спасибо за помощь.
Дополнительную пользовательскую функции сделать просто.
Но сейчас задача стоит, "привязавшись" к корректности ввода данных, определить прошедшее время (дни) между событиями и на контрольные даты, используя ячейки вывода результатов разницы дат. Пока сумбурно изложил. Не справлюсь сам, выложу расширенный пример.

Добавлено через 1 час 31 минуту
Hugo121,
попробовал таким образом, но не срастается
????
строчки 21-29

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
Option Explicit
 
Function Корректно(vybor As Range) As Boolean
 
Dim i&, arr()
  If WorksheetFunction.Count(vybor) > 0 Then
    arr = vybor.Value
    For i = 1 To UBound(arr, 2)
      If IsEmpty(arr(1, i)) Xor IsEmpty(arr(2, i)) Then Exit Function
    Next
    Корректно = True
  End If
End Function
 
 
Function Pvmail(vybor As Range) As Variant()
Dim v(), i&, j&
  ReDim v(1 To 2, 1 To 5)
 
'блок для работы с датами
    Dim dt1, dt2 As Date
    Dim dy As Integer
    dt1 = Cells(1, vybor.Columns(1).Offset(, -12))
    dt2 = Cells(1, vybor.Columns(1))
    dy = DateDiff("d", dt1, dt2)
         
         With Cells(1, vybor.Columns(1).Offset(, -5))
            .Replace IIf(Len(.Value), "*", ""), dy
         End With
 
    
'вывод результатов при корректности исходных данных
  If Корректно(vybor) Then
    v(1, 1) = "сумма"
    v(2, 1) = WorksheetFunction.Sum(vybor) 'например
    v(1, 2) = "среднее"
    v(2, 2) = WorksheetFunction.Average(vybor) 'например
    v(1, 3) = "счет"
    v(2, 3) = WorksheetFunction.Count(vybor) 'например
    v(1, 4) = "что-то"
    v(1, 5) = "что-то"
    v(2, 4) = "что-то"
    v(2, 5) = "что-то"
    
 
'вывод результатов при НЕкорректности исходных данных, для примера
  Else
    For i = 1 To UBound(v, 2)
      For j = 1 To UBound(v)
        v(j, i) = vbNullString
    Next j, i
    v(1, 1) = "данные"
  End If
  Pvmail = v
End Function

хочу выводить разницу дат в заданную ячейку, относительно диапазона ввода данных по каждой дате событий

@Hugo121 · 20.01.2019, 22:36

Visual Basic
1
vybor.Columns(1).Offset(, -12))

- это где?

Покажите файл где не работает - ибо на том, что выше точно работать такое не будет.

@pvmail · 20.01.2019, 22:51 **[ТС]**

да это не правильно
изменю для наглядности, например, так

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
'
'
    Dim dt1, dt2 As Date
    Dim dy As Integer
    dt1 = Cells(1, vybor.Columns(1))  'ячейка С1
    dt2 = Cells(1, vybor.Columns(1).Offset(, 12))  'ячейка N1
    dy = DateDiff("d", dt1, dt2)
         
         With Cells(1, vybor.Columns(1).Offset(5, 2)) 'например, результаты будут выведены в ячейку  Е8
            .Replace IIf(Len(.Value), "*", ""), dy
         End With
'
'
'

@pvmail · 20.01.2019, 22:55 **[ТС]**

Hugo121,

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
Option Explicit
 
Function Корректно(vybor As Range) As Boolean
 
Dim i&, arr()
  If WorksheetFunction.Count(vybor) > 0 Then
    arr = vybor.Value
    For i = 1 To UBound(arr, 2)
      If IsEmpty(arr(1, i)) Xor IsEmpty(arr(2, i)) Then Exit Function
    Next
    Корректно = True
  End If
End Function
 
 
Function Pvmail(vybor As Range) As Variant()
Dim v(), i&, j&
  ReDim v(1 To 2, 1 To 5)
 
'блок для работы с датами
    Dim dt1, dt2 As Date
    Dim dy As Integer
    dt1 = Cells(1, vybor.Columns(1))  'ячейка С1
    dt2 = Cells(1, vybor.Columns(1).Offset(, 12))  'ячейка N1
    dy = DateDiff("d", dt1, dt2)
         
         With Cells(1, vybor.Columns(1).Offset(5, 2)) 'например, результаты будут выведены в ячейку  Е8
            .Replace IIf(Len(.Value), "*", ""), dy
         End With
 
    
'вывод результатов при корректности исходных данных
  If Корректно(vybor) Then
    v(1, 1) = "сумма"
    v(2, 1) = WorksheetFunction.Sum(vybor) 'например
    v(1, 2) = "среднее"
    v(2, 2) = WorksheetFunction.Average(vybor) 'например
    v(1, 3) = "счет"
    v(2, 3) = WorksheetFunction.Count(vybor) 'например
    v(1, 4) = "что-то"
    v(1, 5) = "что-то"
    v(2, 4) = "что-то"
    v(2, 5) = "что-то"
    
 
'вывод результатов при НЕкорректности исходных данных, для примера
  Else
    For i = 1 To UBound(v, 2)
      For j = 1 To UBound(v)
        v(j, i) = vbNullString
    Next j, i
    v(1, 1) = "данные"
  End If
  Pvmail = v
End Function

@Hugo121 · 20.01.2019, 23:19

Попробуйте посмотреть что напишет

Visual Basic
1
Debug.Print vybor.Columns(1).Address

ну или

Visual Basic
1
Debug.Print vybor.Columns(1).Cells(1).Address

а затем как изменить код.
А С1 там никак не получается.

@pvmail · 20.01.2019, 23:22 **[ТС]**

Hugo121,
спасибо, пробую

@Hugo121 · 21.01.2019, 00:00

Блин, пытаюсь взлететь - да как взлетишь с 29.02.2019

Добавлено через 9 минут
Предлагаю упростить так:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Function Pvmail(vybor As Range, dt1 As Date, dt2 As Date, out As Range) As Variant()
    Dim v(), i&, j&
    ReDim v(1 To 2, 1 To 5)
 
    dy = DateDiff("d", dt1, dt2)
    With out    'результаты будут выведены в указанную в параметрах ячейку!
        .Replace IIf(Len(.Value), "*", ""), dy
    End With
 
 
    'вывод результатов при корректности исходных данных
    If Корректно(vybor) Then
        v(1, 1) = "сумма"
        v(2, 1) = WorksheetFunction.Sum(vybor)    'например
        v(1, 2) = "среднее"
        v(2, 2) = WorksheetFunction.Average(vybor)    'например
        v(1, 3) = "счет"
        v(2, 3) = WorksheetFunction.Count(vybor)    'например
        v(1, 4) = "что-то"
        v(1, 5) = "что-то"
        v(2, 4) = "что-то"
        v(2, 5) = "что-то"
 
 
        'вывод результатов при НЕкорректности исходных данных, для примера
    Else
        For i = 1 To UBound(v, 2)
            For j = 1 To UBound(v)
                v(j, i) = vbNullString
            Next j, i
            v(1, 1) = "данные"
        End If
        Pvmail = v
    End Function

Но придётся чуть больше поработать юзеру - добавлены ТРИ параметра:

Visual Basic
1
=Pvmail(D3:I4;D1;O1;J1)

@pvmail · 21.01.2019, 00:54 **[ТС]**

Hugo121,
О-ок!
Это упрощает мои хотелки.
Появляются новые возможности и мысли.
Спасибо и хорошей ночи.

@pvmail · 25.01.2019, 13:46 **[ТС]**

Hugo121, Добрый день.
Возможно Вы подскажете или кто-то другой о "природе" циклической ошибки возникающей в ниже приведенной конструкции. Отследить не удалось, вылетает. Например при изменении значений ввода данных (наглядно по разным датам).
Интересует как исправить?

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Option Explicit
 
Function Корректно(vybor As Range) As Boolean
Dim i&, arr()
  If WorksheetFunction.Count(vybor) > 0 Then
    arr = vybor.Value
    For i = 1 To UBound(arr, 2)
      If IsEmpty(arr(1, i)) Xor IsEmpty(arr(2, i)) Then Exit Function
    Next
    Корректно = True
  End If
End Function
 
Function pvmail(vybor As Range, dt1 As Date, dt2 As Date, out As Range) As Variant()
    Dim v(), i&, j&, dy&
    ReDim v(1 To 2, 1 To 5)
 
    dy = DateDiff("d", dt1, dt2)
    With out    'результаты будут выведены в указанную в параметрах ячейку!
        .Replace IIf(Len(.Value), "*", ""), dy
    End With
'MsgBox dy
 
    'вывод результатов при корректности исходных данных
    If Корректно(vybor) Then
        v(1, 1) = "сумма"
        v(2, 1) = WorksheetFunction.Sum(vybor)    'например
        v(1, 2) = "среднее"
        v(2, 2) = WorksheetFunction.Average(vybor)    'например
        v(1, 3) = "счет"
        v(2, 3) = WorksheetFunction.Count(vybor)    'например
 
 
 
        'вывод результатов при НЕкорректности исходных данных, для примера
    Else
        For i = 1 To UBound(v, 2)
            For j = 1 To UBound(v)
                v(j, i) = vbNullString
            Next j, i
            v(1, 1) = "no"
        End If
        pvmail = v
    End Function

@pvmail · 25.01.2019, 23:05 **[ТС]**

Часть проблемы "вылета" нашёл.
Была ошибка в декларировании и фактическом количестве ячеек вывода результатов ReDim v(1 To 2, 1 To 5), а нужно было ... To 3. Но...

Теперь при попытке редактирования функции pvmail через ячейку листа, выскакивает поочередно 2 сообщение "Все готово. Сделано замен: 1". При изменении данных в любых полях окна функции также выскакивает по 2 сообщение. И в конце при закрытии окна функции также.
.
Кто знает, как избежать этого?

Забыл ещё упомянуть, что иногда в других диапазонах вывода результатов на да ту же дату (dt2) прописываются ошибки #ЗНАЧ!

Новые блоги и статьи Все статьи Все блоги /
SDL3 для Web (WebAssembly): Основы отладки веб-приложений на SDL3 по USB и Wi-Fi, запущенных в браузере мобильных устройств 8Observer8 07.02.2026 Содержание блога Браузер Chrome имеет средства для отладки мобильных веб-приложений по USB. В этой пошаговой инструкции ограничимся работой с консолью. Вывод в консоль - это часть процесса. . .	SDL3 для Web (WebAssembly): Обработчик клика мыши в браузере ПК и касания экрана в браузере на мобильном устройстве 8Observer8 02.02.2026 Содержание блога Для начала пошагово создадим рабочий пример для подготовки к экспериментам в браузере ПК и в браузере мобильного устройства. Потом напишем обработчик клика мыши и обработчик. . .	Философия технологии iceja 01.02.2026 На мой взгляд у человека в технических проектах остается роль генерального директора. Все остальное нейронки делают уже лучше человека. Они не могут нести предпринимательские риски, не могут. . .	SDL3 для Web (WebAssembly): Вывод текста со шрифтом TTF с помощью SDL3_ttf 8Observer8 01.02.2026 Содержание блога В этой пошаговой инструкции создадим с нуля веб-приложение, которое выводит текст в окне браузера. Запустим на Android на локальном сервере. Загрузим Release на бесплатный. . .
SDL3 для Web (WebAssembly): Сборка C/C++ проекта из консоли 8Observer8 30.01.2026 Содержание блога Если вы откроете примеры для начинающих на официальном репозитории SDL3 в папке: examples, то вы увидите, что все примеры используют следующие четыре обязательные функции, а. . .	SDL3 для Web (WebAssembly): Установка Emscripten SDK (emsdk) и CMake для сборки C и C++ приложений в Wasm 8Observer8 30.01.2026 Содержание блога Для того чтобы скачать Emscripten SDK (emsdk) необходимо сначало скачать и уставить Git: Install for Windows. Следуйте стандартной процедуре установки Git через установщик. . . .	SDL3 для Android: Подключение Box2D v3, физика и отрисовка коллайдеров 8Observer8 29.01.2026 Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами. Версия v3 была полностью переписана на Си, в. . .	Инструменты COM: Сохранение данный из VARIANT в файл и загрузка из файла в VARIANT bedvit 28.01.2026 Сохранение базовых типов COM и массивов (одномерных или двухмерных) любой вложенности (деревья) в файл, с возможностью выбора алгоритмов сжатия и шифрования. Часть библиотеки BedvitCOM Использованы. . .

@pvmail 0 / 0 / 0 Регистрация: 10.01.2018 Сообщений: 29
	15.01.2019, 12:39 [ТС]
	Может быть, как вариант, использовать lastColumn, lastRow 0

@pvmail 0 / 0 / 0 Регистрация: 10.01.2018 Сообщений: 29
	20.01.2019, 20:09 [ТС]
	Hugo121, Спасибо. Работает. Попробую с более сложными конструкциями. 0

@Hugo121 6998 / 2896 / 555 Регистрация: 19.10.2012 Сообщений: 8,804
	20.01.2019, 20:38
	Надёжнее и правильнее в Range("i1") прописать другую UDF, работающую аналогично с Pvmail, но выводящую только одно значение. 0

@pvmail 0 / 0 / 0 Регистрация: 10.01.2018 Сообщений: 29
	20.01.2019, 23:22 [ТС]
	Hugo121, спасибо, пробую 0

@pvmail 0 / 0 / 0 Регистрация: 10.01.2018 Сообщений: 29
	21.01.2019, 00:54 [ТС]
	Hugo121, О-ок! Это упрощает мои хотелки. Появляются новые возможности и мысли. Спасибо и хорошей ночи. 0

@pvmail 0 / 0 / 0 Регистрация: 10.01.2018 Сообщений: 29
	25.01.2019, 23:05 [ТС]
	Часть проблемы "вылета" нашёл. Была ошибка в декларировании и фактическом количестве ячеек вывода результатов ReDim v(1 To 2, 1 To 5), а нужно было ... To 3. Но... Теперь при попытке редактирования функции pvmail через ячейку листа, выскакивает поочередно 2 сообщение "Все готово. Сделано замен: 1". При изменении данных в любых полях окна функции также выскакивает по 2 сообщение. И в конце при закрытии окна функции также. . Кто знает, как избежать этого? Забыл ещё упомянуть, что иногда в других диапазонах вывода результатов на да ту же дату (dt2) прописываются ошибки #ЗНАЧ! 0