*VBA* | Помогите написать макросы для Excel'я

[azbest]

Извините, в этом помочь не могу. :drug:

[Margarittka]

Спасибо всем!!!!!!!!!!!!!!!
Все работает просто потрясающе!!!!!!!!!!!!!!!!!!!!

[MaryMegg]

Добрый день.
Помогите пожалуйста. Вопрос такой:
Есть Книга в Ecxel, в ней 3 листа...
1-й лист - опросник; 2-ой лист - обрабатывает данные опроса, 3-й должен содержать в себе (по строкам) ФИО из 1-ого листа и данные из 2-ого листа. Должно быть опрошено 60 чел. и соответственно на 3-ем листе должна появиться таблица из 60 строк с ФИО и данными опроса по каждому.
На 1-ом листе имеется кнопка Сохранить, после ввода данных каждым участником нажатие этой кнопки должно приводить к перемещению данных относящихся к данному участнику опроса в таблицу на 3-ем листе, а опросник приводиться в исходный вид (очищаться).
Основной вопрос в следующем, как добиться того, чтобы данные о каждом следующем участнике записывались в следующую строку.
Советам по другим моментам грамотного написания данного макроса буду рада.
Заранее спасибо:-)

[Pliomera]

Основной вопрос в следующем, как добиться того, чтобы данные о каждом следующем участнике записывались в следующую строку. »

Для этого надо определить номер последней занятой строки. Для этого немножко курим мануал по ключевым словам Cells(..., ...).End(xlDown)

[vik]

Доброго времени суток всем. Помогите пожалуйста.
Требуется каждую ячейку выделенного блока скопировать на отдельный лист книги.
т.е. одная ячейка- один лист.
Примерно вот так.
Саша- ячейка на лист1
Петя-ячейка на лист2
Миша-ячейка на лист3
и.т.д.
Заранее спасибо

Доброго времени суток всем. Помогите пожалуйста.
Требуется каждую ячейку выделенного блока скопировать на отдельный лист книги.
т.е. одная ячейка- один лист.
Примерно вот так.
Саша- ячейка на лист1
Петя-ячейка на лист2
Миша-ячейка на лист3
и.т.д.
Заранее спасибо.

[Pliomera]

vik,

Sub CellsCopy()
x = 1
With Selection
For i = 1 To .Columns.Count
For j = 1 To .Rows.Count
x = x + 1
If x > Sheets.Count Then Sheets.Add after:=Sheets(x - 1)
Sheets(x).Cells(1, 1).Value = .Cells(j, i).Value
Next j
Next i
End With
End Sub

[vik]

Pliomera,

Спасибо!!!!!
То что надо!

[MR.TOR]

Пожалуйста помогите.
Нужен макрос для Excel, чтоб в документе в каждой заполненной ячейке содержимое брал в одинарные кавычки и перед началом ставил пробел, пример : пробел'0000'
Буду очень признателен всем кто посодействует!

[Delirium]

MR.TOR, ячейки должны задаваться или же просто нужен обход всех ячеек листа? Как пример - для диапазона в 500 строк и 500 столбцов:

Sub Макрос1()
For i = 1 To 500
For j = 1 To 500
If Cells(i, j) <> "" Then
Cells(i, j) = " '" & Cells(i, j) & "'"
End If
Next
Next
MsgBox "Готово"
End Sub
P.S. И перестаньте писать капсом, первое предупреждение.

[MR.TOR]

Delirium спаибо Вам большое. Очень сильно выручили! Этот макрос для Excel, это то что мне нужно для моей роботы. Большое человеческое спасибо!

[Delirium]

MR.TOR, всегда рады помочь :)

[Большой Кол]

Помогите пожалуйста написать макрос. Мне нужно что бы из всех книг Excel удалялись все строки в которых первый столбец содержит МИ ( например МИ №1 или МИ №3 или МИ25), причем такие строки идут вперемешку с тем что надо оставить(а это все остальное).
Например

Х| A | B |
1| МИ 10 | 25 |
2| РФ | 100 |

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


Вот что я на ваял

Sub MySub()

Dim x As Worksheet
Dim a As Integer
For Each x In ActiveWorkbook.Sheets
If Not x.Cells.Find(what:="МИ") Is Nothing Then
With x
a = CStr(x.Cells.Find(what:="МИ").Row)
.Rows(a & ":" & a).Delete Shift:=xlUp
End With
End If
Next x

End Sub

Но не работает - вообще ничего не удаляет . Где я ошибся?

[Delirium]

Большой Кол, всего навсего использовали не тот цикл, потому и не удаляло. Рабочий код:

Dim x As Worksheet
Dim a As Integer
For Each x In ActiveWorkbook.Sheets
While Not x.Cells.Find(what:="МИ") Is Nothing
With x
a = CStr(x.Cells.Find(what:="МИ").Row)
.Rows(a & ":" & a).Delete Shift:=xlUp
End With
Wend
Next x

[BonoU2]

ребята программисты, помогите плиз, нужно в книге выделить цветом на 2-х листах ячейки с одинаковыми записями (я выделил их вручную как бы я хотел что б это делалось). А еще лучше чтоб отобранные данніе сопоставлялись в отдельнои листе. Помогите с макросом. Заранее благодарен
Прилагаю файл (записей много потому он большой).

[Delirium]

BonoU2, по каким полям проводить сверку? В выделенном примере на листе выделена запись с номером 001602. На первом листе 2 строки с таким номером.

[BonoU2]

сравнения с листа 803 - ТОЛЬКО по столбцам e,f и листа Новичівська тоже ТОЛЬКО столбцы e,f , но при етом мне надо результат (я сделал вручную) как на листе1 - в виде столбцов, возможно так? заранее благодарен. (прикрепил переделланый чучуть)

[Delirium]

Макрос запускается по сочетанию клавиш Ctrl+E. После отработки выводит сообщение Done и открывается результативный лист.

В архиве 2 файла, один в формате Excel 2003, другой - в формате Excel 2007. Они идентичны.

[BonoU2]

Delirium огромное спасибо, а как сравнить только по столбцам f ? пожалуйста дайте цикл макроса ибо как мне использовать на других файлах?

[Delirium]

BonoU2, открываем Excel, жмем Alt+F11, открывается окно макросов, переходим на вкладку Modules - там и будет исходный текст нашего макроса. Ниже приведен его текст:



'
'
' Сочетание клавиш: Ctrl+e
'
Dim RowCountL1 As Integer
Dim RowCountL2 As Integer
Dim ResultIndex As Integer



Sheets("803").Select
Range("A1").Select
RowCountL1 = ActiveSheet.UsedRange.Rows.Count ' Кол-во строк на первом листе (803 который)

Sheets("Новичівська").Select
Range("A1").Select
RowCountL2 = ActiveSheet.UsedRange.Rows.Count ' Кол-во строк на втором листе


ResultIndex = 2
For i = 2 To RowCountL1
For j = 2 To RowCountL2
If Sheets("803").Cells(i, 5) = Sheets("Новичівська").Cells(j, 5) And Sheets("803").Cells(i, 6) = Sheets("Новичівська").Cells(j, 6) Then

Sheets("Result").Cells(ResultIndex, 1) = Sheets("803").Cells(i, 1)
Sheets("Result").Cells(ResultIndex, 2) = Sheets("803").Cells(i, 2)
Sheets("Result").Cells(ResultIndex, 3) = Sheets("803").Cells(i, 3)
Sheets("Result").Cells(ResultIndex, 4) = Sheets("803").Cells(i, 4)
Sheets("Result").Cells(ResultIndex, 5) = Sheets("803").Cells(i, 5)
Sheets("Result").Cells(ResultIndex, 6) = Sheets("803").Cells(i, 6)

Sheets("Result").Cells(ResultIndex, 8) = Sheets("Новичівська").Cells(j, 1)
Sheets("Result").Cells(ResultIndex, 9) = Sheets("Новичівська").Cells(j, 2)
Sheets("Result").Cells(ResultIndex, 10) = Sheets("Новичівська").Cells(j, 3)
Sheets("Result").Cells(ResultIndex, 11) = Sheets("Новичівська").Cells(j, 4)
Sheets("Result").Cells(ResultIndex, 12) = Sheets("Новичівська").Cells(j, 5)
Sheets("Result").Cells(ResultIndex, 13) = Sheets("Новичівська").Cells(j, 6)

ResultIndex = ResultIndex + 1
End If
Next j
Next i
MsgBox "Done"
Sheets("Result").Activate



Строка
If Sheets("803").Cells(i, 5) = Sheets("Новичівська").Cells(j, 5) And Sheets("803").Cells(i, 6) = Sheets("Новичівська").Cells(j, 6)
проверяет по нужным столбцам. Соответственно, если необходимо сравнивать только по столбцу F, то нужно убрать условие Sheets("803").Cells(i, 5) = Sheets("Новичівська").Cells(j, 5)

Для использования в других файлах:
ОТкрываем документ, идем Сервис-Макросы - Начать запись. Перед началом записи выбираем сочетание на клавиатуре для запуска. Начинаем запись и тут же останавливаем. Запускаем редактор (Alr+F11) и вставляем наш код. Следует учесть, что в макросе идет привязка к номерам столбцов, поэтому, если структура документа другая, то необходимо будет предварительно подправить код.

[BonoU2]

Delirium Извените что надоедаю.вроде бы переделал так ка Вы говорили но что-то у меня не идет, останавливается, посмотрите пожалуйста вложение, я в коде переименовал листы и только по F сравниваю, правильно ли я сделал? и в дальнейшем если я просто в етот файл буду вставлять другие значения соответственно в лист 1 и 2 будет ли работать код? Заранее благодарен