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

Вход

Регистрация

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

 

= Мир MS Excel/Заполнение столбца при сравнение двух массивов данных - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Заполнение столбца при сравнение двух массивов данных (Макросы/Sub)
Заполнение столбца при сравнение двух массивов данных
KOLLIAK Дата: Пятница, 10.06.2016, 13:01 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Всем добрый день,

На другом форуме мне не смогли подсказать.
Может быть у Вас получится что то узнать.

Есть файл на листе 1 которого, представленны данные ввиде таблицы (дата, время, и прочее) в некоторых из строк , некоторые ячейки выделены жирным.
И есть лист 2 на котором есть список дат, и времени, и третий столбец который требует заполнения.

макрос должен сравнивать первые два столбца (только в связке) на листе 1 с данными листа два, находить полные совпадения после чего смотреть есть ли на листе 1 в совпадающей строке ячейки выделенные жирным, и если есть то на лице 2 ставить 1

Файл пример также прикрепил.

Спасибо всем кто прочтет, или тем более откликнется.

пытался как то приспособить данный макрос... но ничего не вышло(

[vba]
Код
Sub Find_Matches()
Dim CompareRange As Variant, x As Variant, y As Variant

Set CompareRange = Worksheets("Лист1").Range("A1:B100")
For Each x In CompareRange
For Each y In Selection
If x = y And y.Font.Bold Then x.Offset(0, 3) = "Fix"
Next y
Next x
End Sub
[/vba]

ссылка на форум Plex - http://www.planetaexcel.ru/forum....e657876
К сообщению приложен файл: _3.xlsx(42Kb)


Сообщение отредактировал KOLLIAK - Пятница, 10.06.2016, 13:08
 
Ответить
СообщениеВсем добрый день,

На другом форуме мне не смогли подсказать.
Может быть у Вас получится что то узнать.

Есть файл на листе 1 которого, представленны данные ввиде таблицы (дата, время, и прочее) в некоторых из строк , некоторые ячейки выделены жирным.
И есть лист 2 на котором есть список дат, и времени, и третий столбец который требует заполнения.

макрос должен сравнивать первые два столбца (только в связке) на листе 1 с данными листа два, находить полные совпадения после чего смотреть есть ли на листе 1 в совпадающей строке ячейки выделенные жирным, и если есть то на лице 2 ставить 1

Файл пример также прикрепил.

Спасибо всем кто прочтет, или тем более откликнется.

пытался как то приспособить данный макрос... но ничего не вышло(

[vba]
Код
Sub Find_Matches()
Dim CompareRange As Variant, x As Variant, y As Variant

Set CompareRange = Worksheets("Лист1").Range("A1:B100")
For Each x In CompareRange
For Each y In Selection
If x = y And y.Font.Bold Then x.Offset(0, 3) = "Fix"
Next y
Next x
End Sub
[/vba]

ссылка на форум Plex - http://www.planetaexcel.ru/forum....e657876

Автор - KOLLIAK
Дата добавления - 10.06.2016 в 13:01
Roman777 Дата: Пятница, 10.06.2016, 13:42 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 783
Репутация: 88 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
KOLLIAK, как понял, так и сделал. Попробуйте так:
[vba]
Код
Sub Opr_FontSt()
Dim i&, k&
Dim o As Object, key As String
Dim r As Range
Set o = CreateObject("Scripting.Dictionary")
i_n& = Worksheets(2).Cells(Rows.count, 1).End(xlUp).Row
For i = 1 To i_n
  key = Worksheets(2).Cells(i, 1).Text & Worksheets(2).Cells(i, 2).Text
  If Not o.exists(key) Then
     k = k + 1
     o.Add key, k
  End If
Next i
i_n& = Worksheets(1).Cells(Rows.count, 1).End(xlUp).Row
For i = 1 To i_n
  key = Worksheets(1).Cells(i, 1).Text & Worksheets(1).Cells(i, 2).Text
  If o.exists(key) Then
     For Each r In Worksheets(1).Cells(i, 3).Resize(, 7)
        If r.Font.Bold Then
           Worksheets(2).Cells(o(key), 3) = 1
           Exit For
        End If
     Next r
  End If
Next i
End Sub
[/vba]


Много чего не знаю!!!!
 
Ответить
СообщениеKOLLIAK, как понял, так и сделал. Попробуйте так:
[vba]
Код
Sub Opr_FontSt()
Dim i&, k&
Dim o As Object, key As String
Dim r As Range
Set o = CreateObject("Scripting.Dictionary")
i_n& = Worksheets(2).Cells(Rows.count, 1).End(xlUp).Row
For i = 1 To i_n
  key = Worksheets(2).Cells(i, 1).Text & Worksheets(2).Cells(i, 2).Text
  If Not o.exists(key) Then
     k = k + 1
     o.Add key, k
  End If
Next i
i_n& = Worksheets(1).Cells(Rows.count, 1).End(xlUp).Row
For i = 1 To i_n
  key = Worksheets(1).Cells(i, 1).Text & Worksheets(1).Cells(i, 2).Text
  If o.exists(key) Then
     For Each r In Worksheets(1).Cells(i, 3).Resize(, 7)
        If r.Font.Bold Then
           Worksheets(2).Cells(o(key), 3) = 1
           Exit For
        End If
     Next r
  End If
Next i
End Sub
[/vba]

Автор - Roman777
Дата добавления - 10.06.2016 в 13:42
KOLLIAK Дата: Пятница, 10.06.2016, 14:00 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
KOLLIAK, как понял, так и сделал. Попробуйте так:


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

[vba]
Код
For Each r In Worksheets(1).Cells(i, 3).Resize(, 7)
[/vba]

например на 15. и тогда он будет искать по всей строке в 15 столбцах?

а так все работает! спасибо Вам огромное!
 
Ответить
Сообщение
KOLLIAK, как понял, так и сделал. Попробуйте так:


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

[vba]
Код
For Each r In Worksheets(1).Cells(i, 3).Resize(, 7)
[/vba]

например на 15. и тогда он будет искать по всей строке в 15 столбцах?

а так все работает! спасибо Вам огромное!

Автор - KOLLIAK
Дата добавления - 10.06.2016 в 14:00
Manyasha Дата: Пятница, 10.06.2016, 14:00 | Сообщение № 4
Группа: Модераторы
Ранг: Старожил
Сообщений: 1990
Репутация: 819 ±
Замечаний: 0% ±

Excel 2010, 2016
И у меня тоже со словариком )
[vba]
Код
Sub test()
    Set sh1 = ThisWorkbook.Sheets(1)
    Set sh2 = ThisWorkbook.Sheets(2)
    With sh1
        lr = .Cells(Rows.Count, 1).End(xlUp).Row
        lc = .Cells(1, Columns.Count).End(xlToLeft).Column
        Set dic = CreateObject("scripting.dictionary")
        For i = 2 To lr
            For j = 3 To lc
                If .Cells(i, j) = "ок" And .Cells(i, j).Font.Bold = True Then
                    dic.Add Trim(.Cells(i, 1) & "|" & .Cells(i, 2)), i
                End If
            Next j
        Next i
    End With
    With sh2
        lr = .Cells(Rows.Count, 1).End(xlUp).Row
        .[c1].Resize(lr).ClearContents
        For i = 2 To lr
            If dic.Exists(Trim(.Cells(i, 1) & "|" & .Cells(i, 2))) Then .Cells(i, 3) = 1
        Next i
    End With
End Sub
[/vba]
К сообщению приложен файл: _3-1.xlsm(51Kb)


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеИ у меня тоже со словариком )
[vba]
Код
Sub test()
    Set sh1 = ThisWorkbook.Sheets(1)
    Set sh2 = ThisWorkbook.Sheets(2)
    With sh1
        lr = .Cells(Rows.Count, 1).End(xlUp).Row
        lc = .Cells(1, Columns.Count).End(xlToLeft).Column
        Set dic = CreateObject("scripting.dictionary")
        For i = 2 To lr
            For j = 3 To lc
                If .Cells(i, j) = "ок" And .Cells(i, j).Font.Bold = True Then
                    dic.Add Trim(.Cells(i, 1) & "|" & .Cells(i, 2)), i
                End If
            Next j
        Next i
    End With
    With sh2
        lr = .Cells(Rows.Count, 1).End(xlUp).Row
        .[c1].Resize(lr).ClearContents
        For i = 2 To lr
            If dic.Exists(Trim(.Cells(i, 1) & "|" & .Cells(i, 2))) Then .Cells(i, 3) = 1
        Next i
    End With
End Sub
[/vba]

Автор - Manyasha
Дата добавления - 10.06.2016 в 14:00
KOLLIAK Дата: Пятница, 10.06.2016, 14:06 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
И у меня тоже со словариком )


И Ваш вариант тоже работает)) спасибо большое!

Уже начал переделывать вариант романа под свои нужды)) но все равно огромное спасибо за то что откликнулись)
 
Ответить
Сообщение
И у меня тоже со словариком )


И Ваш вариант тоже работает)) спасибо большое!

Уже начал переделывать вариант романа под свои нужды)) но все равно огромное спасибо за то что откликнулись)

Автор - KOLLIAK
Дата добавления - 10.06.2016 в 14:06
Roman777 Дата: Пятница, 10.06.2016, 14:31 | Сообщение № 6
Группа: Проверенные
Ранг: Ветеран
Сообщений: 783
Репутация: 88 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
достаточно вот здесь поменять 7 на необходимое число?

да, Вы верно поняли, метод Resize(,) так и работает. Изменяет диапазон на Resize(количество строк, количество столбцов). Если пишем Resize(n) изменяем только по строкам, если Resize(, n) - изменяем только по столбцам.


Много чего не знаю!!!!
 
Ответить
Сообщение
достаточно вот здесь поменять 7 на необходимое число?

да, Вы верно поняли, метод Resize(,) так и работает. Изменяет диапазон на Resize(количество строк, количество столбцов). Если пишем Resize(n) изменяем только по строкам, если Resize(, n) - изменяем только по столбцам.

Автор - Roman777
Дата добавления - 10.06.2016 в 14:31
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Заполнение столбца при сравнение двух массивов данных (Макросы/Sub)
Страница 1 из 11
Поиск:

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