Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Распределение значений по критерию
 
#1
29.09.2022 11:01:01
Господа есть задачка. Нужен скрипт на кнопку. Файл приложен. Есть книга состоящая из 3 листов. В первом листе, согласно таблицы, заполняются сведения. В зависимости от значения ячейки столбца L первого листа и выбранного мною диапазона анализируемых строк (указываю в ячейках М4 и М5) другие значения этой строки копируются на 2 либо 3 лист в таблицу. Этот вопрос возможно решить с помощью цикла. Но вот самый "геморрой", который я даже не знаю как сформулировать в сети заключается в следующем:
1. 2 и 3 лист имеют определенные формы и форматирование. Строки с 1 по 8 и обозначенные желтым цветом во 2 и 3 листе не должны меняться.
2. Количество строк (между строками с 1 по 8 и обозначенные желтым цветом во 2 и 3 листе) меняется в зависимости от количество скопированных сведений из листа
В прикрепленном файле я обозначил в качестве примера как это должно быть.
Если набрать этот скрипт долгое время, то сообщите как хоть правильно называется этот процесс в котором количество строк меняется от количества копированных значений. Заранее спасибо! С меня + в карму)))
 
 
 
#2
29.09.2022 11:09:15
Константин Поляков,
давайте разбираться
1) как определить на какой лист копировать?
2) в М4 и М5 Вы будете указывать номера строк, которые необходимо перенести?
3) количество листов, куда нужно скопировать данные всегда только 2?
4) может ли измениться порядок столбцов на всех листах?
Изменено: evgeniygeo - 29.09.2022 11:13:46
 
 
 
#3
29.09.2022 11:14:21
1. Если значение параметра 6 (лист1) содержит "0000000C", то переносим данные во 2 лист, любые оставшиеся значения в 3 лист, только если ячейка параметра 6 заполнена.
2. Да номера строк. Что бы можно мне было вручную выбирать диапазон.
3. Да только 2ва
4. Нет
Изменено: Константин Поляков - 29.09.2022 11:18:40
 
 
 
#4
29.09.2022 11:16:22
evgeniygeo, 1. Если значение параметра 6 (лист1) содержит "0000000C", то переносим данные во 2 лист, любые оставшиеся значения в 3 лист, только если ячейка параметра 6 заполнена.
2. Да номера строк. Что бы можно мне было вручную выбирать диапазон.
 
 
 
#5
29.09.2022 11:25:09
Константин Поляков,
вариант (до появления доп инфо)
Код
Sub a()
sh = ActiveSheet.Range("M2").Value
    For n = ActiveSheet.Range("M4").Value To ActiveSheet.Range("M5").Value
        If ActiveSheet.Range("M2").Value = "2" Then
        lLastRow = Sheets(sh).Cells(Rows.Count, 1).End(xlUp).Row
        ActiveSheet.Cells(n, 4).Copy Sheets(sh).Cells(lLastRow + 1, 1)
        ActiveSheet.Cells(n, 5).Copy Sheets(sh).Cells(lLastRow + 1, 2)
        ActiveSheet.Cells(n, 6).Copy Sheets(sh).Cells(lLastRow + 1, 3)
        ActiveSheet.Cells(n, 8).Copy Sheets(sh).Cells(lLastRow + 1, 5)
        ActiveSheet.Cells(n, 9).Copy Sheets(sh).Cells(lLastRow + 1, 6)
        Else:
        lLastRow = Sheets(sh).Cells(Rows.Count, 1).End(xlUp).Row
        ActiveSheet.Cells(n, 4).Copy Sheets(sh).Cells(lLastRow + 1, 1)
        ActiveSheet.Cells(n, 5).Copy Sheets(sh).Cells(lLastRow + 1, 2)
        ActiveSheet.Cells(n, 6).Copy Sheets(sh).Cells(lLastRow + 1, 3)
        ActiveSheet.Cells(n, 8).Copy Sheets(sh).Cells(lLastRow + 1, 4)
        ActiveSheet.Cells(n, 9).Copy Sheets(sh).Cells(lLastRow + 1, 5)
        End If
    Next
End Sub
Изменено: evgeniygeo - 29.09.2022 11:29:04
 
 
 
#6
29.09.2022 11:32:18
Не работает
 
 
 
#7
29.09.2022 11:36:56
Константин Поляков,
c учетом новой инфы вот так:
Код
Sub a()
sh = ActiveSheet.Range("M2").Value
    For n = ActiveSheet.Range("M4").Value To ActiveSheet.Range("M5").Value
        If ActiveSheet.Cells(n, 12) = "0000000C " Then
        lLastRow = Sheets("2").Cells(Rows.Count, 1).End(xlUp).Row
        ActiveSheet.Cells(n, 4).Copy Sheets("2").Cells(lLastRow + 1, 1)
        ActiveSheet.Cells(n, 5).Copy Sheets("2").Cells(lLastRow + 1, 2)
        ActiveSheet.Cells(n, 6).Copy Sheets("2").Cells(lLastRow + 1, 3)
        ActiveSheet.Cells(n, 8).Copy Sheets("2").Cells(lLastRow + 1, 5)
        ActiveSheet.Cells(n, 9).Copy Sheets("2").Cells(lLastRow + 1, 6)
        Else:
        lLastRow = Sheets("3").Cells(Rows.Count, 1).End(xlUp).Row
        ActiveSheet.Cells(n, 4).Copy Sheets("3").Cells(lLastRow + 1, 1)
        ActiveSheet.Cells(n, 5).Copy Sheets("3").Cells(lLastRow + 1, 2)
        ActiveSheet.Cells(n, 6).Copy Sheets("3").Cells(lLastRow + 1, 3)
        ActiveSheet.Cells(n, 7).Copy Sheets("3").Cells(lLastRow + 1, 4)
        ActiveSheet.Cells(n, 8).Copy Sheets("3").Cells(lLastRow + 1, 5)
        ActiveSheet.Cells(n, 9).Copy Sheets("3").Cells(lLastRow + 1, 6)
        End If
    Next
End Sub
Изменено: evgeniygeo - 29.09.2022 11:40:03
 
 
 
#8
29.09.2022 11:41:10
Цитата
Константин Поляков написал:
не работает
Вы понимаете, что этой информации недостаточно? Что конкретно не работает?
 
 
 
#9
29.09.2022 11:42:26
Не совсем то, что я хотел.
Выбирать лист копирования не нужно. Жестко привязано, что строки с "0000000C" копируются во 2 лист, а все остальные заполненные в 3 лист. не решена главная задача - во 2 и 3 листе остаются пустые строки (придется тогда вручную их удалять)
 
 
 
#10
29.09.2022 11:43:38
В образце указан уже готовый результат (только выполнен вручную)
 
 
 
#11
29.09.2022 11:44:11
Константин Поляков,
посмотрите код из моего сообщения #7
там ровно так, как Вы объснили и с образцом также совпадает
Изменено: evgeniygeo - 29.09.2022 11:47:19
 
 
 
#12
29.09.2022 11:48:49
в первом моём 1 сообщении:
2. Количество строк (между строками с 1 по 8 и обозначенные желтым цветом во 2 и 3 листе) меняется в зависимости от количество скопированных сведений из листа
 
 
 
#13
29.09.2022 11:53:10
Цитата
написал:
Константин Поляков,
посмотрите код из моего сообщения  #7
там ровно так, как Вы объснили и с образцом также совпадает
про название листа я ничего не говорил)) а вы добавили
 
 
 
#14
29.09.2022 12:05:38
Цитата
Константин Поляков написал:
2. Количество строк (между строками с 1 по 8 и обозначенные желтым цветом во 2 и 3 листе) меняется в зависимости от количество скопированных сведений из листа
как меняется? почему меняется? для чего меняется? прочитайте еще раз эту часть сообщения. Вам самому понятно, как это должно выглядеть?
в файле даже желтом они не выделены... :D
Цитата
Константин Поляков написал:
про название листа я ничего не говорил)) а вы добавили
куда добавил? в последней версии я убрал с листа ячейку для названия листа...
Изменено: evgeniygeo - 29.09.2022 12:08:10
 
 
 
#15
29.09.2022 12:20:46
Цитата
написал:
Цитата
Константин Поляков написал:
2. Количество строк (между строками с 1 по 8 и обозначенные желтым цветом во 2 и 3 листе) меняется в зависимости от количество скопированных сведений из листа
как меняется? почему меняется? для чего меняется? прочитайте еще раз эту часть сообщения. Вам самому понятно, как это должно выглядеть?
в файле даже желтом они не выделены...  
Цитата
Константин Поляков написал:
про название листа я ничего не говорил)) а вы добавили
куда добавил? в последней версии я убрал с листа ячейку для названия листа...
))) 2 и 3 лист - это определенные бланки которые я потом распечатываю. Есть Шапка бланка (с 1 по 8 строку) и реквизиты  с 20 строки и ниже. Между шапкой и реквизитами находится таблица, которую я и должен заполнить. Если из 1 листа я отфильтровываю 100 строк, то значит между шапкой и реквизитами должно быть только 100 штук и не более. Если из 1 листа я отфильтровываю 50 строк, то значит между шапкой и реквизитами должно быть только 50 штук и не более.
В Вашем скрипте строки добавляются - было 10 строк, я отфильтровал 50 стало 60, а мне нужно только 50. И ещё нюанс, если возможно то при новой фильрации, старые данные пусть стираются. Как то так)))
 
 
 
#16
29.09.2022 12:34:13
Константин Поляков,
в таком случае, необходимо понять с какой строки начинаются реквизиты (какой либо ключ) чтобы удалить строки перед работой макроса.

и Вы планируете переносить только отфильтрованные значения с листа 1? тогда это нужно добавить в условия в коде, например проверив все строки на скрытость:
Код
If ActiveSheet.Rows(i).Hidden = True Then


И тогда не просто копировать значения, как это делается в моем коде, а еще перед этим вставлять строки
Код
Rows("40:40").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Изменено: evgeniygeo - 29.09.2022 12:38:32
 
 
 
#17
29.09.2022 12:44:41
Цитата
написал:
Константин Поляков,
в таком случае, необходимо понять с какой строки начинаются реквизиты (какой либо ключ) чтобы удалить строки перед работой макроса.

и Вы планируете переносить только отфильтрованные значения с листа 1? тогда это нужно добавить в условия в коде, например проверив все строки на скрытость:
Код
    [URL=#]?[/URL]       1      If   ActiveSheet.Rows(i).Hidden =   True   Then  
 

И тогда не просто копировать значения, как это делается в моем коде, а еще перед этим вставлять строки
Код
    [URL=#]?[/URL]       1      Rows(  "40:40"  ).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove  
 
)) Давайте определимся, что с 25 строки. Или под ключом можно принять желтый цвет (во 2 и 3 листе снизу), наверно можно в цифровом виде как-то желтый цвет указать.
Я наверно Вас замучал.
 
 
 
#18
29.09.2022 12:46:39
Цитата
написал:
Константин Поляков,
в таком случае, необходимо понять с какой строки начинаются реквизиты (какой либо ключ) чтобы удалить строки перед работой макроса.

и Вы планируете переносить только отфильтрованные значения с листа 1? тогда это нужно добавить в условия в коде, например проверив все строки на скрытость:
Код
    [URL=#]?[/URL]       1      If   ActiveSheet.Rows(i).Hidden =   True   Then  
 

И тогда не просто копировать значения, как это делается в моем коде, а еще перед этим вставлять строки
Код
    [URL=#]?[/URL]       1      Rows(  "40:40"  ).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove  
 
Да только отфильтрованные значения. Тоесть отфильтровал распечатал, следующий диапозон отфильтровал распечатал и т.д. Для этого нужно удаление.
 
 
 
#19
29.09.2022 12:54:26
Цитата
Константин Поляков написал:
Давайте определимся, что с 25 строки
вы же понимаете, что данная строка может сместиться и она уже не будет 25-ой, поэтому ее нужно как-то определить в коде, например поиском какого-то значения в столбце А.
Цитата
Константин Поляков написал:
Да только отфильтрованные значения
тогда как вариант воспользуйтесь условием из предыдущего сообщения или еще как вариант можете кодом отфильтровать значения, которые нужно перенести на один лист, а после отфильтровать для второго листа и также перенести.
как пример:
Код
Range("A16:C40").SpecialCells(xlCellTypeVisible).Copy Worksheets("2").Range("A11")
Изменено: evgeniygeo - 29.09.2022 12:56:22
 
 
 
#20
29.09.2022 13:02:36
Цитата
написал:
Цитата
Константин Поляков написал:
Давайте определимся, что с 25 строки
вы же понимаете, что данная строка может сместиться и она уже не будет 25-ой, поэтому ее нужно как-то определить в коде, например поиском какого-то значения в столбце А.
Цитата
Константин Поляков написал:
Да только отфильтрованные значения
тогда как вариант воспользуйтесь условием из предыдущего сообщения или еще как вариант можете кодом отфильтровать значения, которые нужно перенести на один лист, а после отфильтровать для второго листа и также перенести.
как пример:
Код
    [URL=#]?[/URL]       1      Range(  "A16:C40"  ).SpecialCells(xlCellTypeVisible).Copy Worksheets(  "2"  ).Range(  "A11"  )  
 
Да понимаю, давайте определимся, что ключом будет наличие фразы "Reasons for Repairing:" в столбце A (реквизиты).
Последний полный Ваш скрипт меня вполне устраивает, только добавить вот это - добавление и удаление строк (что бы только отфильтрованные строки были.)
 
 
 
#21
29.09.2022 13:07:34
Цитата
Константин Поляков написал:
что ключом будет наличие фразы "Reasons for Repairing:" в столбце A (реквизиты).
в таком случае, можно использовать Find:
Код
Set fcell = sheats("2").Columns("A:A").Find("Reasons for Repairing:")
If Not fcell Is Nothing Then
    MsgBox "нашел в строке: " + CStr(fcell.Row)
End If
Изменено: evgeniygeo - 29.09.2022 13:08:50
 
 
 
#22
29.09.2022 13:11:19
Цитата
написал:
Цитата
Константин Поляков написал:
что ключом будет наличие фразы "Reasons for Repairing:" в столбце A (реквизиты).
в таком случае, можно использовать Find:
Код
    [URL=#]?[/URL]       1  2  3  4      Set   fcell = sheats(  "2"  ).Columns(  "A:A"  ).Find(  "Reasons for Repairing:"  )    If   Not   fcell   Is   Nothing   Then          MsgBox   "нашел в строке: "   +   CStr  (fcell.Row)    End   If  
 
А итоговый,  целый скрипт можно? Я уже совсем запутался
 
 
 
#23
29.09.2022 13:18:26
Цитата
Константин Поляков написал:
целый скрипт можно?
можно, но данный раздел не предполагает, что все сделают за Вас)))
ПРАВИЛА ФОРУМА
Цитата
2.7. Если вам нужен не совет по самостоятельному решению задачи, а чтобы все сделали за вас - добро пожаловать в ветку Работа. Там, скорее всего, найдутся специалисты, которые разберутся с вашей проблемой быстро, качественно и за разумную плату.
 
 
 
#24
29.09.2022 13:20:07
Цитата
написал:
Цитата
Константин Поляков написал:
целый скрипт можно?
можно, но данный раздел не предполагает, что все сделают за Вас)))
ПРАВИЛА ФОРУМА
Цитата
2.7. Если вам нужен не совет по самостоятельному решению задачи, а чтобы все сделали за вас - добро пожаловать в ветку Работа. Там, скорее всего, найдутся специалисты, которые разберутся с вашей проблемой быстро, качественно и за разумную плату.
Абсолютно верно)) и на этом спасибо! дальше буду сам допиливать))
 
 
 
Страницы: 1
Наверх