VBA сравнение ячеек и значений

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

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

VBA сравнение ячеек и значений (Макросы/Sub)

AxelTT

Дата: Пятница, 14.10.2016, 01:27 | Сообщение № 1

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

Ранг: Прохожий

Сообщений: 6

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

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

Excel 2013

Не могу реализовать VBA сравнение

Есть данные :
1) Столбец из 100-400 ячеек в каждой ячейке находится 16значный алфавитно-цифровой номер.
Например :
DAX2009855855555
AUC2009849066666

2) Каждому номер нужно едино разово присвоить значение
Например :
DAX2009855855555 это = « ручные весы v23 »
AUC2009849066666 это = « самовар v3 »

Каждый день я получаю номера из 100- 400 ячеек и нужно что бы их проверило на то значение что я им присвоил п.2. И вывело список товара, а если значение не присвоено в п.2, то что бы выводилась надпись например NEW, и по возможности что бы список товара выводился в те же ячейке в которых находился 16ти значный код.

Думаю что это возможно сделать на VBA в Excel, но к сожалению мои познания не позволяют это сделать.

Помогите пожалуйста!

Ответить

Pelena

Дата: Пятница, 14.10.2016, 08:50 | Сообщение № 2

Группа: Админы

Ранг: Местный житель

Сообщений: 19401

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

Замечаний: ±

Excel 365 & Mac Excel

Файл с примером помог бы в понимании задачи

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Ответить

Hugo

Дата: Пятница, 14.10.2016, 08:50 | Сообщение № 3

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

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

Сообщений: 3689

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

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

365

Это можно сделать с помощью функций листа ВПР() и ЕСЛИ() и чуть поработать руками, если нужно (копирование-спецвставка).

webmoney: E265281470651 Z422237915069
USDT TRC20: TN8XeEF17o5KPBD9pNwYzNyruycuAc2mVD

Ответить

AxelTT

Дата: Пятница, 14.10.2016, 10:28 | Сообщение № 4

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

Ранг: Прохожий

Сообщений: 6

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

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

Excel 2013

Рабочий файлик который каждый день приходит с новыми номерами называется TMP V1.xlsx
Номера с которыми работать в столбце К

Ну и собственно база товара в файлике BD.xlsx может быть эту базу можно как то разместить внутри кода VBA?

Задача что бы сравнило код в ячейках столбца К с БД и вставило в ячейки столбца К данные с БД

На данном уровне для меня эта задача не выполнима, помогите пожалуйста

К сообщению приложен файл: BD.xlsx (8.5 Kb) · TMP_V1.xlsx (14.9 Kb)

Ответить

Manyasha

Дата: Пятница, 14.10.2016, 11:41 | Сообщение № 5

Группа: Модераторы

Ранг: Старожил

Сообщений: 2198

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

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

Excel 2010, 2016

AxelTT, так подойдет?
[vba]

Код

Sub compareData()
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With
    Dim i&, newWB As Workbook, dic As Object
    Set dic = CreateObject("scripting.dictionary")
    With ThisWorkbook.Sheets(1)
        For i = 5 To .Cells(Rows.Count, "d").End(xlUp).Row
            dic(Trim(.Cells(i, "d"))) = .Cells(i, "f")
        Next i
    End With
    Set newWB = Workbooks.Open(ThisWorkbook.Path & "\TMP_V1.xlsx")
    With newWB.Sheets(1)
        For i = 7 To .Cells(Rows.Count, "k").End(xlUp).Row
            If dic.exists(Trim(.Cells(i, "k"))) Then
                .Cells(i, "k") = dic(Trim(.Cells(i, "k")))
            Else
                .Cells(i, "k") = "New"
            End If
        Next i
    End With
    newWB.Save
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With
End Sub

[/vba]

К сообщению приложен файл: compareData.rar (24.6 Kb)

ЯД: 410013299366744 WM: R193491431804

Ответить

AxelTT

Дата: Пятница, 14.10.2016, 15:39 | Сообщение № 6

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

Ранг: Прохожий

Сообщений: 6

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

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

Excel 2013

Manyasha,

спасибочки, буду разбираться

Ответить

Hugo

Дата: Пятница, 14.10.2016, 15:50 | Сообщение № 7

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

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

Сообщений: 3689

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

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

365

Manyasha, тут точки не хватает перед Rows:
[vba]

Код

With ThisWorkbook.Sheets(1)
For i = 5 To .Cells(Rows.Count,

[/vba]
т.к. в такой комбинации условий ThisWorkbook и активная книга могут быть из разных поколений, что иногда может привести к браку в работе.

webmoney: E265281470651 Z422237915069
USDT TRC20: TN8XeEF17o5KPBD9pNwYzNyruycuAc2mVD

Ответить

AxelTT

Дата: Пятница, 14.10.2016, 16:19 | Сообщение № 8

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

Ранг: Прохожий

Сообщений: 6

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

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

Excel 2013

Странно, при первом нажатии на кнопку Сравнение вроде все ОК, но если нажать повторно на Сравнение то все ячейки К принимают значение NEW.
Это только у меня так?

Ответить

Manyasha

Дата: Пятница, 14.10.2016, 16:32 | Сообщение № 9

Группа: Модераторы

Ранг: Старожил

Сообщений: 2198

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

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

Excel 2010, 2016

Hugo, Вы правы, я 2003-м не пользуюсь (да и на работе таких нет), поэтому допускаю такую запись)

AxelTT,

Цитата AxelTT, 14.10.2016 в 10:28, в сообщении № 4

Задача что бы сравнило код в ячейках столбца К с БД и вставило в ячейки столбца К данные с БД

после запуска макроса, данные в столбце К уже не являются кодом.
Можно проставлять код в соседний столбец:
[vba]

Код

    With newWB.Sheets(1)
        For i = 7 To .Cells(Rows.Count, "k").End(xlUp).Row
            If dic.exists(Trim(.Cells(i, "k"))) Then
                .Cells(i, "l") = dic(Trim(.Cells(i, "k")))'код пишем в столбец L
            Else
                .Cells(i, "l") = "New"
            End If
        Next i
    End With

[/vba]

ЯД: 410013299366744 WM: R193491431804

Ответить

AxelTT

Дата: Пятница, 14.10.2016, 17:14 | Сообщение № 10

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

Ранг: Прохожий

Сообщений: 6

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

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

Excel 2013

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

Ответить

Manyasha

Дата: Пятница, 14.10.2016, 21:45 | Сообщение № 11

Группа: Модераторы

Ранг: Старожил

Сообщений: 2198

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

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

Excel 2010, 2016

AxelTT,
[vba]

Код

Sub compareData()
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With
    Dim i&, newWB As Workbook, dic As Object, j
    Set dic = CreateObject("scripting.dictionary")
    With ThisWorkbook.Sheets(1)
        For i = 5 To .Cells(Rows.Count, "d").End(xlUp).Row
            For Each j In Array(4, 6) 'столбцы D и F
                dic(Trim(.Cells(i, j))) = .Cells(i, "f")
            Next j
        Next i
    End With
    Set newWB = Workbooks.Open(ThisWorkbook.Path & "\TMP_V1.xlsx")
    With newWB.Sheets(1)
        For i = 7 To .Cells(Rows.Count, "k").End(xlUp).Row
            If dic.exists(Trim(.Cells(i, "k"))) Then
                .Cells(i, "k") = dic(Trim(.Cells(i, "k")))
            Else
                .Cells(i, "k") = "New"
            End If
        Next i
    End With
    newWB.Save
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With
End Sub

[/vba]