Работа с xls - сравнение столбцов, с примерами в ТЗ - Страница 3

Старая форма входа

Страница 3 из 3 « 1 2 3
Модератор форума: китин, _Boroda_

Работа с xls - сравнение столбцов, с примерами в ТЗ

Anatoliy45

Дата: Пятница, 29.06.2012, 16:34 | Сообщение № 41

Группа: Пользователи

Ранг: Новичок

Сообщений: 11

Репутация: 0 ±

Замечаний: 0% ±

1 и 2 столбец - столбцы где будем искать
3 столбец - что будем искать

E и F - решение для 2 товаров сделал руками

столбец D подтягивается вместе с С в решение, там это видно

К сообщению приложен файл: for_forum.xlsx (95.1 Kb)

Сообщение отредактировал Anatoliy45 - Пятница, 29.06.2012, 16:51

Ответить

Hugo

Дата: Пятница, 29.06.2012, 18:38 | Сообщение № 42

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3690

Репутация: 790 ±

Замечаний: 0% ±

365

Quote (Gustav)

...шли годы... они говорили... раз в сутки по фразе...

Что-то мне вспомнилось "игра в шахматы по переписке" smile

Не знаю, было где-то такое или что-то путаю... Но вообще в век "только почты" такое могло быть. Очень неспешное развлечение smile

webmoney: E265281470651 Z422237915069
USDT TRC20: TN8XeEF17o5KPBD9pNwYzNyruycuAc2mVD

Ответить

LightZ

Дата: Пятница, 29.06.2012, 18:54 | Сообщение № 43

Группа: Авторы

Ранг: Форумчанин

Сообщений: 120

Репутация: 48 ±

Замечаний: 0% ±

[vba]

Code

Sub io()
     Dim i&, j&, li&
     Dim FinalA&, FinalC&
     Dim Arr(), Arr2()
     Dim tm!: tm = Timer
     Application.ScreenUpdating = False
     FinalA = Cells(Rows.Count, 1).End(xlUp).Row
     FinalC = Cells(Rows.Count, 3).End(xlUp).Row

     Arr = Range("a2:b" & FinalA).Value
     Arr2 = Range("c2:d" & FinalC).Value

     For i = 1 To UBound(Arr)
         Arr(i, 1) = Application.Trim(UCase(Arr(i, 1)))
         Arr(i, 2) = Application.Trim(UCase(Arr(i, 2)))
     Next
     For i = 1 To UBound(Arr2)
         Arr2(i, 1) = Application.Trim(UCase(Arr2(i, 1)))
         Arr2(i, 2) = Application.Trim(UCase(Arr2(i, 2)))
     Next

     For i = 1 To UBound(Arr)
         For j = 1 To UBound(Arr2)
             If Arr2(j, 1) Like "*" & Arr(i, 1) & "*" Then
                 Cells(1 + i, "e").Value = Arr2(j, 1)
                 Cells(1 + i, "f").Value = Arr2(j, 2)
             End If
         Next
     Next
     i = 0: j = 0
     For i = 1 To UBound(Arr)
         For j = 1 To UBound(Arr2)
             If Arr2(j, 1) Like "*" & Arr(i, 2) & "*" Then
                 Cells(1 + i, "e").Value = Arr(j, 1)
                 Cells(1 + i, "f").Value = Arr(j, 2)
             End If
         Next
     Next

     Application.ScreenUpdating = True
End Sub

[/vba]