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

Вход

Регистрация

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

 

= Мир MS Excel/Перенос данных за определенную дату на другой лист - Мир MS Excel

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

2010
Добрый день уважаемые форумчани.
Когда-то с Вашей помощью создал таблицу и вот прошу помощи для ее модернизации.
В примере упрощенный вариант.
Нужно, чтобы на лист статистика добавлялись данные с листа Об-е. А именно дата ремонта т.е. когда какое оборудование пошло в ремонт.
Для указания причины сделаю текстбокс (с этим разобрался).
На форуме нашел несколько подобных тем, но там макросы переносят данные из одной формы в точно такую-же (или можно на весь год сделать-протянуть и скрыть(тяжелый вариант)).
Помогите с макросом который бы искал данные.
К сообщению приложен файл: 2277969.xlsx(11Kb)


Сообщение отредактировал roman66rus - Вторник, 28.06.2016, 19:22
 
Ответить
СообщениеДобрый день уважаемые форумчани.
Когда-то с Вашей помощью создал таблицу и вот прошу помощи для ее модернизации.
В примере упрощенный вариант.
Нужно, чтобы на лист статистика добавлялись данные с листа Об-е. А именно дата ремонта т.е. когда какое оборудование пошло в ремонт.
Для указания причины сделаю текстбокс (с этим разобрался).
На форуме нашел несколько подобных тем, но там макросы переносят данные из одной формы в точно такую-же (или можно на весь год сделать-протянуть и скрыть(тяжелый вариант)).
Помогите с макросом который бы искал данные.

Автор - roman66rus
Дата добавления - 28.06.2016 в 13:27
Udik Дата: Вторник, 28.06.2016, 15:29 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 1215
Репутация: 153 ±
Замечаний: 0% ±

Excel 2013
если правильно понял
[vba]
Код

Option Explicit

Public Sub test()
    Dim Rng1 As Range
    Dim rng2 As Range
    Dim i As Integer, j%, k%, lastRow%
    
    Set Rng1 = Worksheets("Об-е").UsedRange
    Set rng2 = Worksheets("Статистика").UsedRange
    Worksheets("Статистика").Range("A2:D100").ClearContents
    
    lastRow = Worksheets("Об-е").Cells(Rows.Count, 1).End(xlUp).Row
    k = 2

    While Rng1.Cells(1, 3 + i).Value <> ""
    j = 2
    While j <= lastRow
    If Val(Rng1.Cells(j, 3 + i).Value) + Val(Rng1.Cells(j, 3 + i+1).Value) > 0 Then
        rng2.Cells(k, 1).Value = Rng1.Cells(1, 3 + i).Value
        rng2.Cells(k, 2).Value = Rng1.Cells(j, 1).Value
        rng2.Cells(k, 3).Value = Val(Rng1.Cells(j, 3 + i).Value) + Val(Rng1.Cells(j, 3 + i + 1).Value)
        
        k = k + 1
    End If
    j = j + 1
    Wend
    i = i + 2
    Wend
End Sub

[/vba]
К сообщению приложен файл: 0878375.xlsm(19Kb)


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com


Сообщение отредактировал Udik - Вторник, 28.06.2016, 15:35
 
Ответить
Сообщениеесли правильно понял
[vba]
Код

Option Explicit

Public Sub test()
    Dim Rng1 As Range
    Dim rng2 As Range
    Dim i As Integer, j%, k%, lastRow%
    
    Set Rng1 = Worksheets("Об-е").UsedRange
    Set rng2 = Worksheets("Статистика").UsedRange
    Worksheets("Статистика").Range("A2:D100").ClearContents
    
    lastRow = Worksheets("Об-е").Cells(Rows.Count, 1).End(xlUp).Row
    k = 2

    While Rng1.Cells(1, 3 + i).Value <> ""
    j = 2
    While j <= lastRow
    If Val(Rng1.Cells(j, 3 + i).Value) + Val(Rng1.Cells(j, 3 + i+1).Value) > 0 Then
        rng2.Cells(k, 1).Value = Rng1.Cells(1, 3 + i).Value
        rng2.Cells(k, 2).Value = Rng1.Cells(j, 1).Value
        rng2.Cells(k, 3).Value = Val(Rng1.Cells(j, 3 + i).Value) + Val(Rng1.Cells(j, 3 + i + 1).Value)
        
        k = k + 1
    End If
    j = j + 1
    Wend
    i = i + 2
    Wend
End Sub

[/vba]

Автор - Udik
Дата добавления - 28.06.2016 в 15:29
roman66rus Дата: Вторник, 28.06.2016, 18:06 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 87
Репутация: 0 ±
Замечаний: 20% ±

2010
Udik, немного не так, нужно в статистику переносить только даты ремонта. Например об-е 2 Рем такого-то числа и на тот момент оно отработало столько-то часов.
[moder]Переименуйте тему более конкретно в соответствии с п2 Правил форума.
Прошу помогающих больше не отвечать до исправления названия темы, ответы буду удалять.[/moder]


Сообщение отредактировал Manyasha - Вторник, 28.06.2016, 18:44
 
Ответить
СообщениеUdik, немного не так, нужно в статистику переносить только даты ремонта. Например об-е 2 Рем такого-то числа и на тот момент оно отработало столько-то часов.
[moder]Переименуйте тему более конкретно в соответствии с п2 Правил форума.
Прошу помогающих больше не отвечать до исправления названия темы, ответы буду удалять.[/moder]

Автор - roman66rus
Дата добавления - 28.06.2016 в 18:06
roman66rus Дата: Вторник, 28.06.2016, 19:26 | Сообщение № 4
Группа: Пользователи
Ранг: Участник
Сообщений: 87
Репутация: 0 ±
Замечаний: 20% ±

2010
В примере нужно добавить столбец часы, и еще не получается с объединенных ячеек даты брать. А объединенные ячейки использую потому что за сутки у нас 2 смены работает.
К сообщению приложен файл: _3.xls(45Kb)


Сообщение отредактировал roman66rus - Вторник, 28.06.2016, 19:28
 
Ответить
СообщениеВ примере нужно добавить столбец часы, и еще не получается с объединенных ячеек даты брать. А объединенные ячейки использую потому что за сутки у нас 2 смены работает.

Автор - roman66rus
Дата добавления - 28.06.2016 в 19:26
RAN Дата: Вторник, 28.06.2016, 19:53 | Сообщение № 5
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4277
Репутация: 829 ±
Замечаний: 0% ±

2010
В примере нужно добавить столбец часы

И кто мешает? Палкой его, палкой!
По файлу.
Если на то, чтобы понять хотелку, нужно более 5 минут, ваши шансы на ответ начинают падать.
Когда вы начинаете говорить загадками, ваши шансы начинают падать очень сильно.
Например об-е 2 Рем такого-то числа и на тот момент оно отработало столько-то часов.

Объединенные ячейки, коих, кстати, в файле нет, зло. Они существенно усложняют любой макрос.


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

И кто мешает? Палкой его, палкой!
По файлу.
Если на то, чтобы понять хотелку, нужно более 5 минут, ваши шансы на ответ начинают падать.
Когда вы начинаете говорить загадками, ваши шансы начинают падать очень сильно.
Например об-е 2 Рем такого-то числа и на тот момент оно отработало столько-то часов.

Объединенные ячейки, коих, кстати, в файле нет, зло. Они существенно усложняют любой макрос.

Автор - RAN
Дата добавления - 28.06.2016 в 19:53
roman66rus Дата: Вторник, 28.06.2016, 20:41 | Сообщение № 6
Группа: Пользователи
Ранг: Участник
Сообщений: 87
Репутация: 0 ±
Замечаний: 20% ±

2010
Вот еще получилось дописать как надо. Подскажите как, чтобы данные не повторялись, а ставились новые с текущей даты.
К сообщению приложен файл: 8063977.xls(46Kb)
 
Ответить
СообщениеВот еще получилось дописать как надо. Подскажите как, чтобы данные не повторялись, а ставились новые с текущей даты.

Автор - roman66rus
Дата добавления - 28.06.2016 в 20:41
Kamikadze_N Дата: Среда, 29.06.2016, 13:37 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 42
Репутация: 5 ±
Замечаний: 0% ±

Excel 2010
roman66rus, У вас неточности в коде, поправил их, и сделал более адаптированным.
К сообщению приложен файл: ___.xlsm(23Kb)
 
Ответить
Сообщениеroman66rus, У вас неточности в коде, поправил их, и сделал более адаптированным.

Автор - Kamikadze_N
Дата добавления - 29.06.2016 в 13:37
Kamikadze_N Дата: Среда, 29.06.2016, 16:41 | Сообщение № 8
Группа: Пользователи
Ранг: Новичок
Сообщений: 42
Репутация: 5 ±
Замечаний: 0% ±

Excel 2010
Прошу прощения, если лист чистый формировался макрос ошибку выкидывал, вот исправленный код[vba]
Код
Sub Макрос1()

Dim strLastRow As Long, gLastRow As Long
Dim stlstCol As Integer, L As Date
With Sheets("сводка")
  strLastRow = Cells(Rows.Count, 1).End(xlUp).Row
  gLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
  stlLastCol = Cells(1, Columns.Count).End(xlToRight).Column
  g = gLastRow
  If g > 2 Then L = .Cells(g, 1)
  End If
    For a = 3 To stlLastCol
    For i = 2 To strLastRow
If Cells(i, a) = "рем" Then
If L < Cells(1, a) Then
g = g + 1
.Cells(g, 1).Value = Cells(1, a).Value
.Cells(g, 2).Value = Cells(i, 1).Value
  .Cells(g, 3).Value = Cells(i, 2).Value
   .Cells(g, 4).Value = Cells(i, a).Value
   Else: End If
  End If
  Next
  Next
  End With
  Sheets("сводка").Select
  End Sub
[/vba]
 
Ответить
СообщениеПрошу прощения, если лист чистый формировался макрос ошибку выкидывал, вот исправленный код[vba]
Код
Sub Макрос1()

Dim strLastRow As Long, gLastRow As Long
Dim stlstCol As Integer, L As Date
With Sheets("сводка")
  strLastRow = Cells(Rows.Count, 1).End(xlUp).Row
  gLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
  stlLastCol = Cells(1, Columns.Count).End(xlToRight).Column
  g = gLastRow
  If g > 2 Then L = .Cells(g, 1)
  End If
    For a = 3 To stlLastCol
    For i = 2 To strLastRow
If Cells(i, a) = "рем" Then
If L < Cells(1, a) Then
g = g + 1
.Cells(g, 1).Value = Cells(1, a).Value
.Cells(g, 2).Value = Cells(i, 1).Value
  .Cells(g, 3).Value = Cells(i, 2).Value
   .Cells(g, 4).Value = Cells(i, a).Value
   Else: End If
  End If
  Next
  Next
  End With
  Sheets("сводка").Select
  End Sub
[/vba]

Автор - Kamikadze_N
Дата добавления - 29.06.2016 в 16:41
roman66rus Дата: Четверг, 30.06.2016, 11:40 | Сообщение № 9
Группа: Пользователи
Ранг: Участник
Сообщений: 87
Репутация: 0 ±
Замечаний: 20% ±

2010
Kamikadze_N, СПАСИБО БОЛЬШОЕ...то что нужно
 
Ответить
СообщениеKamikadze_N, СПАСИБО БОЛЬШОЕ...то что нужно

Автор - roman66rus
Дата добавления - 30.06.2016 в 11:40
roman66rus Дата: Четверг, 30.06.2016, 16:55 | Сообщение № 10
Группа: Пользователи
Ранг: Участник
Сообщений: 87
Репутация: 0 ±
Замечаний: 20% ±

2010
Kamikadze_N, подскажи а почему когда кнопку на другой лист перенашу макрос не работает
К сообщению приложен файл: _5.xlsm(24Kb)
 
Ответить
СообщениеKamikadze_N, подскажи а почему когда кнопку на другой лист перенашу макрос не работает

Автор - roman66rus
Дата добавления - 30.06.2016 в 16:55
abtextime Дата: Четверг, 30.06.2016, 17:02 | Сообщение № 11
Группа: Проверенные
Ранг: Обитатель
Сообщений: 427
Репутация: 60 ±
Замечаний: 0% ±

Excel 2010
Рискну предположить, что из-за этого:
[vba]
Код
With Sheets("сводка")
...
Sheets("сводка").Select
[/vba]
 
Ответить
СообщениеРискну предположить, что из-за этого:
[vba]
Код
With Sheets("сводка")
...
Sheets("сводка").Select
[/vba]

Автор - abtextime
Дата добавления - 30.06.2016 в 17:02
Manyasha Дата: Четверг, 30.06.2016, 17:58 | Сообщение № 12
Группа: Модераторы
Ранг: Старожил
Сообщений: 1587
Репутация: 669 ±
Замечаний: 0% ±

Excel 2007, 2010
roman66rus, потому что cells уже не те.
внесла правки в код Kamikadze_N:
[vba]
Код
Sub Макрос1()
    Dim strLastRow As Long, gLastRow As Long
    Dim stlstCol As Integer, L As Date
    Dim sh1 As Worksheet
    Set sh1 = ThisWorkbook.Sheets("Об-е")
    With Sheets("сводка")
        strLastRow = sh1.Cells(Rows.Count, 1).End(xlUp).Row
        gLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        stlLastCol = sh1.Cells(1, Columns.Count).End(xlToRight).Column
        g = gLastRow
        If g > 2 Then L = .Cells(g, 1)
        For a = 3 To stlLastCol
            For i = 2 To strLastRow
                If sh1.Cells(i, a) = "рем" Then
                    If L < sh1.Cells(1, a) Then
                        g = g + 1
                        .Cells(g, 1).Value = sh1.Cells(1, a).Value
                        .Cells(g, 2).Value = sh1.Cells(i, 1).Value
                        .Cells(g, 3).Value = sh1.Cells(i, 2).Value
                    Else: End If
                End If
            Next
        Next
    End With
    Sheets("сводка").Select
End Sub
[/vba]


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщениеroman66rus, потому что cells уже не те.
внесла правки в код Kamikadze_N:
[vba]
Код
Sub Макрос1()
    Dim strLastRow As Long, gLastRow As Long
    Dim stlstCol As Integer, L As Date
    Dim sh1 As Worksheet
    Set sh1 = ThisWorkbook.Sheets("Об-е")
    With Sheets("сводка")
        strLastRow = sh1.Cells(Rows.Count, 1).End(xlUp).Row
        gLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        stlLastCol = sh1.Cells(1, Columns.Count).End(xlToRight).Column
        g = gLastRow
        If g > 2 Then L = .Cells(g, 1)
        For a = 3 To stlLastCol
            For i = 2 To strLastRow
                If sh1.Cells(i, a) = "рем" Then
                    If L < sh1.Cells(1, a) Then
                        g = g + 1
                        .Cells(g, 1).Value = sh1.Cells(1, a).Value
                        .Cells(g, 2).Value = sh1.Cells(i, 1).Value
                        .Cells(g, 3).Value = sh1.Cells(i, 2).Value
                    Else: End If
                End If
            Next
        Next
    End With
    Sheets("сводка").Select
End Sub
[/vba]

Автор - Manyasha
Дата добавления - 30.06.2016 в 17:58
roman66rus Дата: Четверг, 30.06.2016, 18:47 | Сообщение № 13
Группа: Пользователи
Ранг: Участник
Сообщений: 87
Репутация: 0 ±
Замечаний: 20% ±

2010
Manyasha, Спасибо
 
Ответить
СообщениеManyasha, Спасибо

Автор - roman66rus
Дата добавления - 30.06.2016 в 18:47
roman66rus Дата: Понедельник, 14.11.2016, 13:54 | Сообщение № 14
Группа: Пользователи
Ранг: Участник
Сообщений: 87
Репутация: 0 ±
Замечаний: 20% ±

2010
Kamikadze_N, Manyasha, вновь прошу у Вас помощи.
Код, что Вы написали ранее работает как и хотелось изначально, т.е. переносит данные на другой лист в последнюю строку. Но в процессе работы выявился недостаток людей которые ежедневно заполняют таблицу, т.е. иногда забывают внести данные. А потом когда вносишь данные за прошедшую дату, код заносит их в последнюю строку, можно ли подправить, чтобы данные за носились по датам, по порядку. Или подскажите какую строку исправить, буду сам пробовать.
 
Ответить
СообщениеKamikadze_N, Manyasha, вновь прошу у Вас помощи.
Код, что Вы написали ранее работает как и хотелось изначально, т.е. переносит данные на другой лист в последнюю строку. Но в процессе работы выявился недостаток людей которые ежедневно заполняют таблицу, т.е. иногда забывают внести данные. А потом когда вносишь данные за прошедшую дату, код заносит их в последнюю строку, можно ли подправить, чтобы данные за носились по датам, по порядку. Или подскажите какую строку исправить, буду сам пробовать.

Автор - roman66rus
Дата добавления - 14.11.2016 в 13:54
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перенос данных за определенную дату на другой лист (Макросы/Sub)
Страница 1 из 11
Поиск:

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