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

Вход

Регистрация

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

 

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

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Сбор данных с одного листа листа на другой
Заяц6628 Дата: Четверг, 11.07.2024, 09:33 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 28
Репутация: 0 ±
Замечаний: 0% ±

Добрый день!
Нужна помощь, написала часть макроса, а вторую дописать не могу. с Лист1 нужно перенести данные на общий лист по признаку если в колонке С стоит "Кто:", то берем данные из ячейки в колонке K и переносим на общий лист в колонку A с названием "Кто:", приложила файл.
Спасибо огромное за помощь!
К сообщению приложен файл: primer.xlsm (124.3 Kb)
 
Ответить
СообщениеДобрый день!
Нужна помощь, написала часть макроса, а вторую дописать не могу. с Лист1 нужно перенести данные на общий лист по признаку если в колонке С стоит "Кто:", то берем данные из ячейки в колонке K и переносим на общий лист в колонку A с названием "Кто:", приложила файл.
Спасибо огромное за помощь!

Автор - Заяц6628
Дата добавления - 11.07.2024 в 09:33
Hugo Дата: Четверг, 11.07.2024, 09:49 | Сообщение № 2
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3370
Репутация: 722 ±
Замечаний: 0% ±

2019
По вопросу - нечто похожее как раз решаем тут:
http://www.excelworld.ru/forum/2-53502-1
Алгоритм может быть аналогичным - идём циклом по листу, ищем "Кто:", как нашли запоминаем всё что нужно из К, и далее будем это добавлять к другим копируемым данным - которые вероятно уже копирует первая часть макроса.


excel@nxt.ru
webmoney: E265281470651 Z422237915069


Сообщение отредактировал Hugo - Четверг, 11.07.2024, 09:53
 
Ответить
СообщениеПо вопросу - нечто похожее как раз решаем тут:
http://www.excelworld.ru/forum/2-53502-1
Алгоритм может быть аналогичным - идём циклом по листу, ищем "Кто:", как нашли запоминаем всё что нужно из К, и далее будем это добавлять к другим копируемым данным - которые вероятно уже копирует первая часть макроса.

Автор - Hugo
Дата добавления - 11.07.2024 в 09:49
Hugo Дата: Четверг, 11.07.2024, 09:58 | Сообщение № 3
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3370
Репутация: 722 ±
Замечаний: 0% ±

2019
Вот дописал:
[vba]
Код

Sub Макрос1()
Dim a(1 To 1, 1 To 3)

  With Sheets("общий лист")
    sz = .Range("F" & Rows.Count).End(xlUp).Row + 1
    For i = 5 To Range("A" & Rows.Count).End(xlUp).Row
    If Cells(i, "C") = "Кто:" Then
    a(1, 1) = Cells(i, "K")
    a(1, 2) = Cells(i + 2, "K")
    a(1, 3) = Cells(i + 6, "K")
    End If
      If Val(Cells(i, "R")) > 0 Then
      .Cells(sz, "A").Resize(1, 3).Value = a
         .Cells(sz, "D") = Cells(i, "F")
         .Cells(sz, "E") = Cells(i, "R")
         .Cells(sz, "F") = Cells(i, "S")
         .Cells(sz, "G") = Cells(i, "X")
         .Cells(sz, "H") = Cells(i, "AA")
         sz = sz + 1
      End If
    Next
  End With
End Sub
[/vba]


excel@nxt.ru
webmoney: E265281470651 Z422237915069


Сообщение отредактировал Hugo - Четверг, 11.07.2024, 10:00
 
Ответить
СообщениеВот дописал:
[vba]
Код

Sub Макрос1()
Dim a(1 To 1, 1 To 3)

  With Sheets("общий лист")
    sz = .Range("F" & Rows.Count).End(xlUp).Row + 1
    For i = 5 To Range("A" & Rows.Count).End(xlUp).Row
    If Cells(i, "C") = "Кто:" Then
    a(1, 1) = Cells(i, "K")
    a(1, 2) = Cells(i + 2, "K")
    a(1, 3) = Cells(i + 6, "K")
    End If
      If Val(Cells(i, "R")) > 0 Then
      .Cells(sz, "A").Resize(1, 3).Value = a
         .Cells(sz, "D") = Cells(i, "F")
         .Cells(sz, "E") = Cells(i, "R")
         .Cells(sz, "F") = Cells(i, "S")
         .Cells(sz, "G") = Cells(i, "X")
         .Cells(sz, "H") = Cells(i, "AA")
         sz = sz + 1
      End If
    Next
  End With
End Sub
[/vba]

Автор - Hugo
Дата добавления - 11.07.2024 в 09:58
Заяц6628 Дата: Четверг, 11.07.2024, 09:59 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 28
Репутация: 0 ±
Замечаний: 0% ±

Hugo, я прочитала не поняла как решение найти на свой вопрос, оно вроде схоже, но как будто не то
 
Ответить
СообщениеHugo, я прочитала не поняла как решение найти на свой вопрос, оно вроде схоже, но как будто не то

Автор - Заяц6628
Дата добавления - 11.07.2024 в 09:59
Hugo Дата: Четверг, 11.07.2024, 10:00 | Сообщение № 5
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3370
Репутация: 722 ±
Замечаний: 0% ±

2019
Подправил код выше - нужно с строки 5 начинать цикл, или даже c первой.
Если не нужны заголовка с этой 1а то:
[vba]
Код

If Val(Cells(i, "R")) > 0 And Cells(i, "A") <> "А" Then
[/vba]
Но важно не путать латиницу с кириллицей!


excel@nxt.ru
webmoney: E265281470651 Z422237915069


Сообщение отредактировал Hugo - Четверг, 11.07.2024, 10:07
 
Ответить
СообщениеПодправил код выше - нужно с строки 5 начинать цикл, или даже c первой.
Если не нужны заголовка с этой 1а то:
[vba]
Код

If Val(Cells(i, "R")) > 0 And Cells(i, "A") <> "А" Then
[/vba]
Но важно не путать латиницу с кириллицей!

Автор - Hugo
Дата добавления - 11.07.2024 в 10:00
Заяц6628 Дата: Четверг, 11.07.2024, 10:07 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 28
Репутация: 0 ±
Замечаний: 0% ±

Hugo, спасибо за помощь, супер решение, помогло!
 
Ответить
СообщениеHugo, спасибо за помощь, супер решение, помогло!

Автор - Заяц6628
Дата добавления - 11.07.2024 в 10:07
Заяц6628 Дата: Пятница, 12.07.2024, 12:05 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 28
Репутация: 0 ±
Замечаний: 0% ±

Hugo, мне потребовалось перенести столбец один куда грузятся данные и у меня ничего не вышло, код тот что я изменила по этому же файлу приложила. Подскажите почему у меня не вышло?
К сообщению приложен файл: primer_kopija.xlsm (124.7 Kb)
 
Ответить
СообщениеHugo, мне потребовалось перенести столбец один куда грузятся данные и у меня ничего не вышло, код тот что я изменила по этому же файлу приложила. Подскажите почему у меня не вышло?

Автор - Заяц6628
Дата добавления - 12.07.2024 в 12:05
Hugo Дата: Пятница, 12.07.2024, 12:29 | Сообщение № 8
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3370
Репутация: 722 ±
Замечаний: 0% ±

2019
Заяц6628, несколько ошибок:
1 почему массив теперь на 10? выгрузка ведь как и была Resize(1, 3)
2 не "номер питомника:", а "номер питомника", или меняйте на листе. Если возможны оба варианта - можно их оба и прописать в коде.
Но такой подход вполне рабочий. Если поправить.

[vba]
Код

Sub Макрос1()
Dim a(1 To 1, 1 To 3)

With Sheets("общий лист")
    sz = .Range("F" & Rows.Count).End(xlUp).Row + 1
    For i = 3 To Range("A" & Rows.Count).End(xlUp).Row
    
    If Cells(i, "C") = "номер питомника" Then a(1, 2) = Cells(i, "K")
    If Cells(i, "C") = "Документ" Then a(1, 3) = Cells(i, "K")
    If Cells(i, "C") = "Кто:" Then Erase a: a(1, 1) = Cells(i, "K")
    
    If Val(Cells(i, "R")) > 0 Then
    .Cells(sz, "A").Resize(1, 3).Value = a
        .Cells(sz, "D") = Cells(i, "F")
        .Cells(sz, "E") = Cells(i, "R")
        .Cells(sz, "F") = Cells(i, "S")
        .Cells(sz, "G") = Cells(i, "X")
        .Cells(sz, "H") = Cells(i, "AA")
        sz = sz + 1
    End If
    Next
End With
End Sub

[/vba]
И вот только заметил - после смены питомника нужно массив очистить, иначе там могу остаться данные другого пистомника! Добавил в код, но это будет работать если первым по питомнику встречается "Кто:"
Нужно в данных определить признак по которому меняется питомник, и очищать в этот момент массив a - тогда в сводный не попадут чужие данные, в случае брака в этих местах просто будет пусто в первых трёх столбцах.


excel@nxt.ru
webmoney: E265281470651 Z422237915069


Сообщение отредактировал Hugo - Пятница, 12.07.2024, 12:42
 
Ответить
СообщениеЗаяц6628, несколько ошибок:
1 почему массив теперь на 10? выгрузка ведь как и была Resize(1, 3)
2 не "номер питомника:", а "номер питомника", или меняйте на листе. Если возможны оба варианта - можно их оба и прописать в коде.
Но такой подход вполне рабочий. Если поправить.

[vba]
Код

Sub Макрос1()
Dim a(1 To 1, 1 To 3)

With Sheets("общий лист")
    sz = .Range("F" & Rows.Count).End(xlUp).Row + 1
    For i = 3 To Range("A" & Rows.Count).End(xlUp).Row
    
    If Cells(i, "C") = "номер питомника" Then a(1, 2) = Cells(i, "K")
    If Cells(i, "C") = "Документ" Then a(1, 3) = Cells(i, "K")
    If Cells(i, "C") = "Кто:" Then Erase a: a(1, 1) = Cells(i, "K")
    
    If Val(Cells(i, "R")) > 0 Then
    .Cells(sz, "A").Resize(1, 3).Value = a
        .Cells(sz, "D") = Cells(i, "F")
        .Cells(sz, "E") = Cells(i, "R")
        .Cells(sz, "F") = Cells(i, "S")
        .Cells(sz, "G") = Cells(i, "X")
        .Cells(sz, "H") = Cells(i, "AA")
        sz = sz + 1
    End If
    Next
End With
End Sub

[/vba]
И вот только заметил - после смены питомника нужно массив очистить, иначе там могу остаться данные другого пистомника! Добавил в код, но это будет работать если первым по питомнику встречается "Кто:"
Нужно в данных определить признак по которому меняется питомник, и очищать в этот момент массив a - тогда в сводный не попадут чужие данные, в случае брака в этих местах просто будет пусто в первых трёх столбцах.

Автор - Hugo
Дата добавления - 12.07.2024 в 12:29
  • Страница 1 из 1
  • 1
Поиск:

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