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

Вход

Регистрация

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

 

= Мир MS Excel/Определение адресов ячеек с числами с цифрами, меньшими на 1 - Мир MS Excel

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

Excel 2016
Здравствуйте, уважаемые специалисты по экселю.
Помогите решить непростую проблему.

На листе представлены начальная ячейка G13 и конечная ячейка W6.
Схема алгоритма выглядит так:

1.Начинается цикл. Адрес начальной ячейки (Сейчас это ячейка W6) проверяется - в нем 0 или цифра отличная от 0 (если 0 то exit sub). Если цифра отличается от 0 - то она записывается в переменную.
2.Проверяются 8 рядом стоящих ячеек (Как я понимаю при помощи команды Offset).
Проверяется например левая верхняя ячейка Offset(-1,-1). Ее значение и ее адрес вносятся в массив. Затем проверяется верхняя ячейка Offset(0,-1), затем верхняя правая Offset(1,-1) - и так далее все 8 ячеек.
В итоге данной работы цикла будет массив 2х8 где в одном ряду будут адреса ячеек, а в другом ряду будут числа. (Это все пока для одной ячейки W6)
3.Затем макрос проверяет - где в этом массиве число, отличающееся от переменной на единицу (в меньшую сторону) и записывает его адрес (соответствующий числу в массиве 2х8) во вторую переменную. (А если таких чисел в массиве несколько - то выхватывает самое первое по списку).
4.Макрос записывает этот полученный из массива адрес ячейки - в строку 18.
5.Затем макрос повторяет цикл, но уже с другим адресом ячейки (взятым из второй переменной).

Подскажите - как этот алгоритм реализовать в ВБА ?
К сообщению приложен файл: 2911211.xls (74.5 Kb)


Сообщение отредактировал ВасилисаЛукьянчикова - Воскресенье, 12.05.2019, 12:03
 
Ответить
СообщениеЗдравствуйте, уважаемые специалисты по экселю.
Помогите решить непростую проблему.

На листе представлены начальная ячейка G13 и конечная ячейка W6.
Схема алгоритма выглядит так:

1.Начинается цикл. Адрес начальной ячейки (Сейчас это ячейка W6) проверяется - в нем 0 или цифра отличная от 0 (если 0 то exit sub). Если цифра отличается от 0 - то она записывается в переменную.
2.Проверяются 8 рядом стоящих ячеек (Как я понимаю при помощи команды Offset).
Проверяется например левая верхняя ячейка Offset(-1,-1). Ее значение и ее адрес вносятся в массив. Затем проверяется верхняя ячейка Offset(0,-1), затем верхняя правая Offset(1,-1) - и так далее все 8 ячеек.
В итоге данной работы цикла будет массив 2х8 где в одном ряду будут адреса ячеек, а в другом ряду будут числа. (Это все пока для одной ячейки W6)
3.Затем макрос проверяет - где в этом массиве число, отличающееся от переменной на единицу (в меньшую сторону) и записывает его адрес (соответствующий числу в массиве 2х8) во вторую переменную. (А если таких чисел в массиве несколько - то выхватывает самое первое по списку).
4.Макрос записывает этот полученный из массива адрес ячейки - в строку 18.
5.Затем макрос повторяет цикл, но уже с другим адресом ячейки (взятым из второй переменной).

Подскажите - как этот алгоритм реализовать в ВБА ?
Автор - ВасилисаЛукьянчикова
Дата добавления - 12.05.2019 в 11:57
RAN Дата: Воскресенье, 12.05.2019, 14:09 | Сообщение № 2
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
[vba]
Код
Sub Мяу()
    Dim r_0 As Range, r As Range, i&, flag As Boolean
    Set r_0 = [W6]
    [f20] = r_0.Address(0, 0)
    Do
        Set r = r_0.Offset(-1, -1).Resize(3, 3)
        flag = False
        For i = 2 To 8 Step 2
            If r_0.Value - r(i).Value = 1 Then
                Set r_0 = r(i)
                Cells(20, Columns.Count).End(xlToLeft).Offset(, 1) = r_0.Address(0, 0)
                flag = True
                Exit For
            End If
        Next
        If flag = False Then Exit Do
        DoEvents
    Loop
End Sub
[/vba]

Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение[vba]
Код
Sub Мяу()
    Dim r_0 As Range, r As Range, i&, flag As Boolean
    Set r_0 = [W6]
    [f20] = r_0.Address(0, 0)
    Do
        Set r = r_0.Offset(-1, -1).Resize(3, 3)
        flag = False
        For i = 2 To 8 Step 2
            If r_0.Value - r(i).Value = 1 Then
                Set r_0 = r(i)
                Cells(20, Columns.Count).End(xlToLeft).Offset(, 1) = r_0.Address(0, 0)
                flag = True
                Exit For
            End If
        Next
        If flag = False Then Exit Do
        DoEvents
    Loop
End Sub
[/vba]
Автор - RAN
Дата добавления - 12.05.2019 в 14:09
ВасилисаЛукьянчикова Дата: Воскресенье, 12.05.2019, 16:06 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 64
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Спасибо.
Все нормально.

Только почему-то в самом конце пути - выводится ячейка F12, хотя там вообще чисел нет.
Хотя по идее - должен выводится адрес ячейки G13, поскольку именно в ней находится 0.

Посоветуйте, как это исправить ?
К сообщению приложен файл: 4351253.xls (82.0 Kb)
 
Ответить
СообщениеСпасибо.
Все нормально.

Только почему-то в самом конце пути - выводится ячейка F12, хотя там вообще чисел нет.
Хотя по идее - должен выводится адрес ячейки G13, поскольку именно в ней находится 0.

Посоветуйте, как это исправить ?
Автор - ВасилисаЛукьянчикова
Дата добавления - 12.05.2019 в 16:06
RAN Дата: Воскресенье, 12.05.2019, 16:11 | Сообщение № 4
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
[vba]
Код
Sub Мяу()
    Dim r_0 As Range, r As Range, i&, flag As Boolean
    Set r_0 = [W6]
    [f20] = r_0.Address(0, 0)
    Do
        Set r = r_0.Offset(-1, -1).Resize(3, 3)
        flag = False
        For i = 2 To 8 Step 2
            If Len(r(i)) Then
                If r_0.Value - r(i).Value = 1 Then
                    Set r_0 = r(i)
                    Cells(20, Columns.Count).End(xlToLeft).Offset(, 1) = r_0.Address(0, 0)
                    flag = True
                    Exit For
                End If
            End If
        Next
        If flag = False Then Exit Do
        DoEvents
    Loop
End Sub
[/vba]

Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение[vba]
Код
Sub Мяу()
    Dim r_0 As Range, r As Range, i&, flag As Boolean
    Set r_0 = [W6]
    [f20] = r_0.Address(0, 0)
    Do
        Set r = r_0.Offset(-1, -1).Resize(3, 3)
        flag = False
        For i = 2 To 8 Step 2
            If Len(r(i)) Then
                If r_0.Value - r(i).Value = 1 Then
                    Set r_0 = r(i)
                    Cells(20, Columns.Count).End(xlToLeft).Offset(, 1) = r_0.Address(0, 0)
                    flag = True
                    Exit For
                End If
            End If
        Next
        If flag = False Then Exit Do
        DoEvents
    Loop
End Sub
[/vba]
Автор - RAN
Дата добавления - 12.05.2019 в 16:11
ВасилисаЛукьянчикова Дата: Воскресенье, 12.05.2019, 16:19 | Сообщение № 5
Группа: Пользователи
Ранг: Участник
Сообщений: 64
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
RAN, спасибо огромное.
 
Ответить
СообщениеRAN, спасибо огромное.
Автор - ВасилисаЛукьянчикова
Дата добавления - 12.05.2019 в 16:19
ВасилисаЛукьянчикова Дата: Воскресенье, 12.05.2019, 16:44 | Сообщение № 6
Группа: Пользователи
Ранг: Участник
Сообщений: 64
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
RAN, подскажите по работе макроса.
Попыталась изменить ваш макрос, чтобы он учитывал соседние ячейки по диагонали тоже.
[vba]
Код

Sub Мяу()
    Dim r_0 As Range, r As Range, i&, flag As Boolean
    Set r_0 = [W6]
    [f20] = r_0.Address(0, 0)
    Do
        Set r = r_0.Offset(-1, -1).Resize(3, 3)
        flag = False
        For i = 1 To 8 Step 1
            If Len(r(i)) Then
                If r_0.Value - r(i).Value = 1 Then
                    Set r_0 = r(i)
                    Cells(20, Columns.Count).End(xlToLeft).Offset(, 1) = r_0.Address(0, 0)
                    flag = True
                    Exit For
                End If
            End If
        Next
        If flag = False Then Exit Do
        DoEvents
    Loop
End Sub
[/vba]

Когда достигает ячейки F8 с числом 33 - то внезапно останавливается.
Хотя рядом находится ячейка G9, с числом 32

Как это исправить ?
К сообщению приложен файл: 1_2.xls (45.5 Kb)


Сообщение отредактировал ВасилисаЛукьянчикова - Воскресенье, 12.05.2019, 16:52
 
Ответить
СообщениеRAN, подскажите по работе макроса.
Попыталась изменить ваш макрос, чтобы он учитывал соседние ячейки по диагонали тоже.
[vba]
Код

Sub Мяу()
    Dim r_0 As Range, r As Range, i&, flag As Boolean
    Set r_0 = [W6]
    [f20] = r_0.Address(0, 0)
    Do
        Set r = r_0.Offset(-1, -1).Resize(3, 3)
        flag = False
        For i = 1 To 8 Step 1
            If Len(r(i)) Then
                If r_0.Value - r(i).Value = 1 Then
                    Set r_0 = r(i)
                    Cells(20, Columns.Count).End(xlToLeft).Offset(, 1) = r_0.Address(0, 0)
                    flag = True
                    Exit For
                End If
            End If
        Next
        If flag = False Then Exit Do
        DoEvents
    Loop
End Sub
[/vba]

Когда достигает ячейки F8 с числом 33 - то внезапно останавливается.
Хотя рядом находится ячейка G9, с числом 32

Как это исправить ?
Автор - ВасилисаЛукьянчикова
Дата добавления - 12.05.2019 в 16:44
RAN Дата: Воскресенье, 12.05.2019, 17:03 | Сообщение № 7
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
3 x3 = 89

Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение3 x3 = 89
Автор - RAN
Дата добавления - 12.05.2019 в 17:03
ВасилисаЛукьянчикова Дата: Воскресенье, 12.05.2019, 17:19 | Сообщение № 8
Группа: Пользователи
Ранг: Участник
Сообщений: 64
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
RAN, теперь все понятно, спасибо
 
Ответить
СообщениеRAN, теперь все понятно, спасибо
Автор - ВасилисаЛукьянчикова
Дата добавления - 12.05.2019 в 17:19
ВасилисаЛукьянчикова Дата: Воскресенье, 12.05.2019, 21:30 | Сообщение № 9
Группа: Пользователи
Ранг: Участник
Сообщений: 64
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
RAN, скажите пожалуйста.
В этом макросе, если поставить в пустую красную ячейку какую-либо букву - то выдается ошибка

И подсвечивается строка:
[vba]
Код
If r_0.Value - r(i).Value = 1 Then
[/vba]

Посоветуйте - как исключить из цикла ячейки r(i).Value, в которых стоят не числа ?
К сообщению приложен файл: 1_3.xls (44.0 Kb)
 
Ответить
СообщениеRAN, скажите пожалуйста.
В этом макросе, если поставить в пустую красную ячейку какую-либо букву - то выдается ошибка

И подсвечивается строка:
[vba]
Код
If r_0.Value - r(i).Value = 1 Then
[/vba]

Посоветуйте - как исключить из цикла ячейки r(i).Value, в которых стоят не числа ?
Автор - ВасилисаЛукьянчикова
Дата добавления - 12.05.2019 в 21:30
RAN Дата: Понедельник, 13.05.2019, 06:10 | Сообщение № 10
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
[vba]
Код
'            If Len(r(i)) Then
If IsNumeric(r(i)) Then
[/vba]

Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение[vba]
Код
'            If Len(r(i)) Then
If IsNumeric(r(i)) Then
[/vba]
Автор - RAN
Дата добавления - 13.05.2019 в 06:10
ВасилисаЛукьянчикова Дата: Понедельник, 13.05.2019, 16:34 | Сообщение № 11
Группа: Пользователи
Ранг: Участник
Сообщений: 64
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
RAN, ясно.
 
Ответить
СообщениеRAN, ясно.
Автор - ВасилисаЛукьянчикова
Дата добавления - 13.05.2019 в 16:34
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Определение адресов ячеек с числами с цифрами, меньшими на 1 (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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