powered by simpleCommunicator - 2.0.38     © 2025 Programmizd 02
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Помогите написать макрос
4 сообщений из 4, страница 1 из 1
Помогите написать макрос
    #39619937
GrandeD
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Добрый день, нужно написать макрос, который бы искал совпадения по дате на двух листах и копировал содержимое строк с совпадающими датами на отдельный лист в строку. В примере пытался переработать под задачу имеющиеся в интернете макросы, но знаний по sql совершенно нет. Заранее благодарен за ответы
...
Рейтинг: 0 / 0
Помогите написать макрос
    #39619943
Фотография big-duke
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
GrandeD,

Для решения задачи SQL не нужен.
...
Рейтинг: 0 / 0
Помогите написать макрос
    #39619953
GrandeD
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
big-duke,
дело в том, что обычно таблица состоит из 2-5 тысяч строк, и постоянно удалять ненужные данные вручную довольно утомительно. Каким инструментом Excel можно воспользоваться в данном случае?
...
Рейтинг: 0 / 0
Помогите написать макрос
    #39620403
GrandeD
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Разобрался, всё оказалось довольно просто.

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
Sub CompareSub()
 
Dim ACell As Range
Dim BCell As Range
Dim CCell As Range
 
For Each ACell In Range("A2", Cells(Rows.Count, 1).End(xlUp))
    For Each BCell In Range("B2", Cells(Rows.Count, 2).End(xlUp))
     
     If BCell.Value = ACell.Value Then
     Cells(BCell.Row, 20).Value = BCell.Value
     BCell.Interior.Color = 5296260
     End If
    Next
Next

Dim LastRow As Long, Rw As Long
LastRow = Cells(Rows.Count, 2).End(xlUp).Row
        Rw = Sheets("Ëèñò3").Cells(Rows.Count, 1).End(xlUp).Row + 1
        For i = 2 To LastRow
            If Sheets("&#203;&#232;&#241;&#242;1").Cells(i, 20) <> "" Then
                Range(Cells(i, 2), Cells(i, 19)).Copy Sheets("&#203;&#232;&#241;&#242;3").Cells(Rw, 1)
                Rw = Rw + 1
            End If
        Next
...
Рейтинг: 0 / 0
4 сообщений из 4, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Помогите написать макрос
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]