Здравствуйте уважаемые Гуру.Помогите пожалуйста решить проблему во вложении файл, нужно сделать кнопку на листе чтобы при нажатии оной с листа "сводная объекты " ,одну из строк с повторяющимся "№ договора" переносился на лист "дебиторка" ,но переносить надо не всю строку целиком,а только ячейки "Название","адрес","тип договора", т.е. в таблице для примера есть объекты с договором №48 вот надо чтобы только одна из них переносилась на другой лист.Огромное спасибо.
Здравствуйте уважаемые Гуру.Помогите пожалуйста решить проблему во вложении файл, нужно сделать кнопку на листе чтобы при нажатии оной с листа "сводная объекты " ,одну из строк с повторяющимся "№ договора" переносился на лист "дебиторка" ,но переносить надо не всю строку целиком,а только ячейки "Название","адрес","тип договора", т.е. в таблице для примера есть объекты с договором №48 вот надо чтобы только одна из них переносилась на другой лист.Огромное спасибо.anofilis
anofilis, добрый день,не нашел в файл-примере,как надо на листе Дебиторка и критерий переноса,-если критерий переноса- Расторгнут(у Вас желтая раскраска),то так,кнопки test и очистка:
[vba]
Код
Sub test() Dim z, i&, j&, m&: z = Sheets("Сводная объекты").Range("A3:I" & Sheets("Сводная объекты").Range("A" & Rows.Count).End(xlUp).Row).Value: m = 1 For i = 2 To UBound(z) If z(i, UBound(z, 2)) = "Расторгнут" Then m = m + 1: For j = 1 To UBound(z, 2): z(m, j) = z(i, j): Next End If Next Sheets("Дебиторка").Range("A1").Resize(m, UBound(z, 2) - 1).Value = z Sheets("Дебиторка").Columns("A:H").AutoFit: Sheets("Дебиторка").Columns("A:C").Delete Sheets("Дебиторка").Columns("C:D").Delete End Sub
[/vba]
anofilis, добрый день,не нашел в файл-примере,как надо на листе Дебиторка и критерий переноса,-если критерий переноса- Расторгнут(у Вас желтая раскраска),то так,кнопки test и очистка:
[vba]
Код
Sub test() Dim z, i&, j&, m&: z = Sheets("Сводная объекты").Range("A3:I" & Sheets("Сводная объекты").Range("A" & Rows.Count).End(xlUp).Row).Value: m = 1 For i = 2 To UBound(z) If z(i, UBound(z, 2)) = "Расторгнут" Then m = m + 1: For j = 1 To UBound(z, 2): z(m, j) = z(i, j): Next End If Next Sheets("Дебиторка").Range("A1").Resize(m, UBound(z, 2) - 1).Value = z Sheets("Дебиторка").Columns("A:H").AutoFit: Sheets("Дебиторка").Columns("A:C").Delete Sheets("Дебиторка").Columns("C:D").Delete End Sub
sv2014, Спасибо за помощь,критерий переноса все повторы номера договора(на цвет можно внимания не обращать),у вас по факту он перенес 5 объектов а должен был перенести 7
sv2014, Спасибо за помощь,критерий переноса все повторы номера договора(на цвет можно внимания не обращать),у вас по факту он перенес 5 объектов а должен был перенести 7anofilis
1. После переноса в "Сводная объекты" будут дыры (т.к. переносится не вся строка) - зачем? Или всёж почитаем значение слова "перенос" и заменим его на "копирование". 2. Не рассказали какую из повторяющихся строк нужно выбирать - можно брать любую, например вторую (когда понятно что есть повтор)?
Вариант, пытаюсь угадать: [vba]
Код
Sub tt() Dim c As Range, dic As Object, i As Long, t$, col As New Collection, el
Set dic = CreateObject("scripting.dictionary"): dic.comparemode = 1
With Sheets("Сводная объекты")
For i = 4 To .UsedRange.Rows.Count t = .Cells(i, 7): dic(t) = dic(t) + 1 If dic(t) = 2 Then col.Add i Next
i = 0 For Each el In col i = i + 1 Sheets("Дебиторка").Cells(i, 1).Resize(, 3) = Array(.Rows(el).Cells(4), .Rows(el).Cells(5), .Rows(el).Cells(8)) Next End With
End Sub
[/vba]
1. После переноса в "Сводная объекты" будут дыры (т.к. переносится не вся строка) - зачем? Или всёж почитаем значение слова "перенос" и заменим его на "копирование". 2. Не рассказали какую из повторяющихся строк нужно выбирать - можно брать любую, например вторую (когда понятно что есть повтор)?
Вариант, пытаюсь угадать: [vba]
Код
Sub tt() Dim c As Range, dic As Object, i As Long, t$, col As New Collection, el
Set dic = CreateObject("scripting.dictionary"): dic.comparemode = 1
With Sheets("Сводная объекты")
For i = 4 To .UsedRange.Rows.Count t = .Cells(i, 7): dic(t) = dic(t) + 1 If dic(t) = 2 Then col.Add i Next
i = 0 For Each el In col i = i + 1 Sheets("Дебиторка").Cells(i, 1).Resize(, 3) = Array(.Rows(el).Cells(4), .Rows(el).Cells(5), .Rows(el).Cells(8)) Next End With
Я запускал из редактора. Но можете заменить макрос sv2014 на мой, но оставьте название - тогда его кнопка будет работать. Ну или задайте на кнопку выполнение моего макроса (через ПКМ), или сделайте другую кнопку. Да, очистки листа в макросе нет. P.S. Нет в моём макросе никакого переноса.
Я запускал из редактора. Но можете заменить макрос sv2014 на мой, но оставьте название - тогда его кнопка будет работать. Ну или задайте на кнопку выполнение моего макроса (через ПКМ), или сделайте другую кнопку. Да, очистки листа в макросе нет. P.S. Нет в моём макросе никакого переноса. Hugo
Hugo, Простите я в Экселе профан и честно говоря не особо понимаю что такое ПКМ и как задавать выполнение макроса на кнопку уж извините но сам я это вряд-ли сделаю
Hugo, Простите я в Экселе профан и честно говоря не особо понимаю что такое ПКМ и как задавать выполнение макроса на кнопку уж извините но сам я это вряд-ли сделаюanofilis