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

Вход

Регистрация

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

 

= Мир MS Excel/Перенос значения ячейки по условию со смещением - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перенос значения ячейки по условию со смещением (Макросы/Sub)
Перенос значения ячейки по условию со смещением
JimDG Дата: Понедельник, 28.11.2022, 14:23 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 0% ±

Здравствуйте! Помогите, пожалуйста, написать макрос. Имеется таблица, формата:
<2022-11-28> дата
<...> произвольная запись
<...>
<...>
<2022-11-28>
<...>
<...>
<...>
Всё расположено в столбце B
Нужно: если в ячейке В - дата, то перенести в ячейку J со смещением на одну строку вниз. Например B2 -> J3, B10 -> J11.
В таблице длина столбца В нерегулярная, от 20 000 до 140 000.

Как я вижу алгоритм:
Если в В i есть данные, то (Если в В i "Дата", то перенести в J i+1, иначе перейти к B i+1), иначе завершить.
 
Ответить
СообщениеЗдравствуйте! Помогите, пожалуйста, написать макрос. Имеется таблица, формата:
<2022-11-28> дата
<...> произвольная запись
<...>
<...>
<2022-11-28>
<...>
<...>
<...>
Всё расположено в столбце B
Нужно: если в ячейке В - дата, то перенести в ячейку J со смещением на одну строку вниз. Например B2 -> J3, B10 -> J11.
В таблице длина столбца В нерегулярная, от 20 000 до 140 000.

Как я вижу алгоритм:
Если в В i есть данные, то (Если в В i "Дата", то перенести в J i+1, иначе перейти к B i+1), иначе завершить.

Автор - JimDG
Дата добавления - 28.11.2022 в 14:23
_Boroda_ Дата: Понедельник, 28.11.2022, 14:40 | Сообщение № 2
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16550
Репутация: 6441 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
1. Прочитайте Правила форума
2. Приложите файл-пример
3. Обязательно макросом нужно?


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщение1. Прочитайте Правила форума
2. Приложите файл-пример
3. Обязательно макросом нужно?

Автор - _Boroda_
Дата добавления - 28.11.2022 в 14:40
JimDG Дата: Понедельник, 28.11.2022, 20:32 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 0% ±

1. Прочитайте Правила форума

Исправился)
2. Приложите файл-пример

Приложил
3. Обязательно макросом нужно?

Если честно, не совсем представляю, как это сделать без макроса
К сообщению приложен файл: 8475227.xls(36.5 Kb)
 
Ответить
Сообщение
1. Прочитайте Правила форума

Исправился)
2. Приложите файл-пример

Приложил
3. Обязательно макросом нужно?

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

Автор - JimDG
Дата добавления - 28.11.2022 в 20:32
_Boroda_ Дата: Вторник, 29.11.2022, 09:12 | Сообщение № 4
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16550
Репутация: 6441 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
А можете файл без макросов приложить? У меня на работе блокировка безопасности стоит, не могу скачивать. Ну, или подождите того, у кого нормально с этим


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеА можете файл без макросов приложить? У меня на работе блокировка безопасности стоит, не могу скачивать. Ну, или подождите того, у кого нормально с этим

Автор - _Boroda_
Дата добавления - 29.11.2022 в 09:12
Serge_007 Дата: Вторник, 29.11.2022, 09:25 | Сообщение № 5
Группа: Админы
Ранг: Местный житель
Сообщений: 15645
Репутация: 2575 ±
Замечаний: ±

Excel 2016
если в ячейке В - дата, то перенести в ячейку J со смещением на одну строку вниз. Например B2 -> J3, B10 -> J11
Задача в такой формулировке решается простой формулой типа
Код
=ЕСЛИОШИБКА(ЕЧИСЛО(B1)*B1;"")
в ячейке J2 и копируем вниз
Подозреваю что надо не это :)

файл без макросов приложить
Во вложении
К сообщению приложен файл: 20221129_JimDG.xls(69.0 Kb)


ЮMoney:41001419691823 | WMR:126292472390
 
Ответить
Сообщение
если в ячейке В - дата, то перенести в ячейку J со смещением на одну строку вниз. Например B2 -> J3, B10 -> J11
Задача в такой формулировке решается простой формулой типа
Код
=ЕСЛИОШИБКА(ЕЧИСЛО(B1)*B1;"")
в ячейке J2 и копируем вниз
Подозреваю что надо не это :)

файл без макросов приложить
Во вложении

Автор - Serge_007
Дата добавления - 29.11.2022 в 09:25
_Boroda_ Дата: Вторник, 29.11.2022, 09:31 | Сообщение № 6
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16550
Репутация: 6441 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
о вложении


Сергей, спасибо.
Да, явно пример слишком упрощен.


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщение
о вложении


Сергей, спасибо.
Да, явно пример слишком упрощен.

Автор - _Boroda_
Дата добавления - 29.11.2022 в 09:31
JimDG Дата: Вторник, 29.11.2022, 09:47 | Сообщение № 7
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 0% ±

Сделал вот так(для примера взял 63 строки в обработку. В рабочем файле количество строк будет варьироваться, потому условие наличия данных в ячейке нужно для завершения цикла):
[vba]
Код

Dim i As Long
    For i = 1 To 63
    If IsEmpty(Cells(i, 2)) = False Then
        If IsDate(Cells(i, 2)) = True Then
            Selection.Copy Cells(i + 1, 10)
            Selection.ClearContents
        Else
        End If
    Else
    End If
    Next i
End Sub
[/vba]

Но он отрабатывает только если я конкретно выделил ячейку с датой, и каждый раз вручную активирую макрос, переносит. То есть, в данном случае срабатывает только конструкция
[vba]
Код

Selection.Copy Cells(i + 1, 10)
Selection.ClearContents
[/vba]

В рабочем файле порядка 50 000 строк, из них с датами только около 700-800.
Нужно чтоб он последовательно обработал каждую строку и перенес даты в другую колонку.

Надеюсь, я правильно составил алгоритм, чтоб разбить задачу на более мелкие:
1. Объявляем переменную i=1
2. Проверяем Cells(i, 2): пустая?
2.1 Если да: завешаем работу макроса
2.1 Если нет:
3. Проверяем формат данных в ячейке
3.1 Если да: копируем из ячейки Cells(i, 2) в ячейку Cells(i+1, 10), переходим к пункту 2.
3.2. Если нет: переходим в ячейку Cells(i+1, 2)переходим к пункту 2.

Как-то так


Сообщение отредактировал JimDG - Вторник, 29.11.2022, 10:35
 
Ответить
СообщениеСделал вот так(для примера взял 63 строки в обработку. В рабочем файле количество строк будет варьироваться, потому условие наличия данных в ячейке нужно для завершения цикла):
[vba]
Код

Dim i As Long
    For i = 1 To 63
    If IsEmpty(Cells(i, 2)) = False Then
        If IsDate(Cells(i, 2)) = True Then
            Selection.Copy Cells(i + 1, 10)
            Selection.ClearContents
        Else
        End If
    Else
    End If
    Next i
End Sub
[/vba]

Но он отрабатывает только если я конкретно выделил ячейку с датой, и каждый раз вручную активирую макрос, переносит. То есть, в данном случае срабатывает только конструкция
[vba]
Код

Selection.Copy Cells(i + 1, 10)
Selection.ClearContents
[/vba]

В рабочем файле порядка 50 000 строк, из них с датами только около 700-800.
Нужно чтоб он последовательно обработал каждую строку и перенес даты в другую колонку.

Надеюсь, я правильно составил алгоритм, чтоб разбить задачу на более мелкие:
1. Объявляем переменную i=1
2. Проверяем Cells(i, 2): пустая?
2.1 Если да: завешаем работу макроса
2.1 Если нет:
3. Проверяем формат данных в ячейке
3.1 Если да: копируем из ячейки Cells(i, 2) в ячейку Cells(i+1, 10), переходим к пункту 2.
3.2. Если нет: переходим в ячейку Cells(i+1, 2)переходим к пункту 2.

Как-то так

Автор - JimDG
Дата добавления - 29.11.2022 в 09:47
_Boroda_ Дата: Вторник, 29.11.2022, 10:32 | Сообщение № 8
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16550
Репутация: 6441 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
[vba]
Код
Sub tt()
    c0_ = 2 'столбец откуда
    c1_ = 10 'столбец куда
    r0_ = 1 'первая строка
    nr_ = Cells(Rows.Count, c0_).End(3).Row - r0_ + 1 'кол-во строк в столбце Откуда
    Cells(r0_, c1_).Resize(Cells(Rows.Count, c1_).End(3).Row).ClearContents 'очищаем Куда
    ar0_ = Cells(r0_, c0_).Resize(nr_).Value 'массив Откуда
    ar1_ = Cells(r0_, c1_).Resize(nr_).Value 'массив Куда (сейчас пустой)
    For i = 1 To nr_'цикл по строкам (в массиве, не на листе!!!. Так намного быстрее)
        If IsDate(ar0_(i, 1)) Then' если дата
            ar1_(i, 1) = ar0_(i, 1)' Присваиваем второму массиву значение первого (в строке i)
        End If
    Next i
    Cells(r0_ + 1, c1_).Resize(nr_).Value = ar1_' Выгружаем второй массив на лист. Со строки на одну ниже
End Sub
[/vba]


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщение[vba]
Код
Sub tt()
    c0_ = 2 'столбец откуда
    c1_ = 10 'столбец куда
    r0_ = 1 'первая строка
    nr_ = Cells(Rows.Count, c0_).End(3).Row - r0_ + 1 'кол-во строк в столбце Откуда
    Cells(r0_, c1_).Resize(Cells(Rows.Count, c1_).End(3).Row).ClearContents 'очищаем Куда
    ar0_ = Cells(r0_, c0_).Resize(nr_).Value 'массив Откуда
    ar1_ = Cells(r0_, c1_).Resize(nr_).Value 'массив Куда (сейчас пустой)
    For i = 1 To nr_'цикл по строкам (в массиве, не на листе!!!. Так намного быстрее)
        If IsDate(ar0_(i, 1)) Then' если дата
            ar1_(i, 1) = ar0_(i, 1)' Присваиваем второму массиву значение первого (в строке i)
        End If
    Next i
    Cells(r0_ + 1, c1_).Resize(nr_).Value = ar1_' Выгружаем второй массив на лист. Со строки на одну ниже
End Sub
[/vba]

Автор - _Boroda_
Дата добавления - 29.11.2022 в 10:32
JimDG Дата: Вторник, 29.11.2022, 11:47 | Сообщение № 9
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 0% ±

Ругается на :(
[vba]
Код
For i=1 To nr_
[/vba]
И пишет, что функция Cells не объявлена %)


Сообщение отредактировал JimDG - Вторник, 29.11.2022, 11:48
 
Ответить
СообщениеРугается на :(
[vba]
Код
For i=1 To nr_
[/vba]
И пишет, что функция Cells не объявлена %)

Автор - JimDG
Дата добавления - 29.11.2022 в 11:47
_Boroda_ Дата: Вторник, 29.11.2022, 11:56 | Сообщение № 10
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16550
Репутация: 6441 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
И как Вы думаете, что нужно сделать?
Или объявите, или сотрите Option Explicit в первой строке


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеИ как Вы думаете, что нужно сделать?
Или объявите, или сотрите Option Explicit в первой строке

Автор - _Boroda_
Дата добавления - 29.11.2022 в 11:56
JimDG Дата: Среда, 30.11.2022, 07:37 | Сообщение № 11
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 0% ±

Макрос заработал, достаточно было вручную его переписать, а не копипастить. Как ни странно.
Дополнил его работу макросом
[vba]
Код

Sub Удалить_пустые_строки()
collJ_ = Cells(Rows.Count, 10).End(3).Row - r0_ + 1
For i = collJ_ To 1 Step -1
    If Cells(i, 10) = "" Then
        Cells(i, 10).EntireRow.Delete
    End If
Next i
End Sub
[/vba]

На 23400 строк операция заняла 17 минут, против 7 часов вручную. Спасибо большое за помощь. Впервые столкнулся с макросами. Понял, насколько интересное направление) Буду дальше развиваться в этом направлении
 
Ответить
СообщениеМакрос заработал, достаточно было вручную его переписать, а не копипастить. Как ни странно.
Дополнил его работу макросом
[vba]
Код

Sub Удалить_пустые_строки()
collJ_ = Cells(Rows.Count, 10).End(3).Row - r0_ + 1
For i = collJ_ To 1 Step -1
    If Cells(i, 10) = "" Then
        Cells(i, 10).EntireRow.Delete
    End If
Next i
End Sub
[/vba]

На 23400 строк операция заняла 17 минут, против 7 часов вручную. Спасибо большое за помощь. Впервые столкнулся с макросами. Понял, насколько интересное направление) Буду дальше развиваться в этом направлении

Автор - JimDG
Дата добавления - 30.11.2022 в 07:37
_Boroda_ Дата: Среда, 30.11.2022, 09:11 | Сообщение № 12
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16550
Репутация: 6441 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
23400 строк операция заняла 17 минут

Скока????
Должно за пару секунд отрабатывать.
Вы работаете с ячейками, а нужно этот момент минимизировать.
Ну, допустим, удалить именно строки (и если, при этом, у Вас таблица с кучей разных форматов, а не просто данные), да, придется по очереди. Хот нет, не обязательно, можно и всей кучей. Но это немного непонятно Вам пока с кодом будет
А пока в самое начало макроса напишите отключение обновления экрана и пересчета. А внизу обратно включите
Вот так примерно
[vba]
Код

Sub Makros_()
    Application.ScreenUpdating = 0
    Application.Calculation = 3

    'Текст макроса

    Application.ScreenUpdating = 1
    Application.Calculation = 1
End Sub
[/vba]


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщение
23400 строк операция заняла 17 минут

Скока????
Должно за пару секунд отрабатывать.
Вы работаете с ячейками, а нужно этот момент минимизировать.
Ну, допустим, удалить именно строки (и если, при этом, у Вас таблица с кучей разных форматов, а не просто данные), да, придется по очереди. Хот нет, не обязательно, можно и всей кучей. Но это немного непонятно Вам пока с кодом будет
А пока в самое начало макроса напишите отключение обновления экрана и пересчета. А внизу обратно включите
Вот так примерно
[vba]
Код

Sub Makros_()
    Application.ScreenUpdating = 0
    Application.Calculation = 3

    'Текст макроса

    Application.ScreenUpdating = 1
    Application.Calculation = 1
End Sub
[/vba]

Автор - _Boroda_
Дата добавления - 30.11.2022 в 09:11
JimDG Дата: Среда, 30.11.2022, 11:07 | Сообщение № 13
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 0% ±

Круто! Помогло. Время выполнения сократилось до 28 секунд! Потрясающе просто))
 
Ответить
СообщениеКруто! Помогло. Время выполнения сократилось до 28 секунд! Потрясающе просто))

Автор - JimDG
Дата добавления - 30.11.2022 в 11:07
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перенос значения ячейки по условию со смещением (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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