Перенос данных с одного листа на другой по условиям

@Admnis · Регистрация: 09.09.2018

Author24 — интернет-сервис помощи студентам

Добрый день, Уважаемые форумчане!
Помогите с решением вот такой задачи
Есть файл категории в нем есть два листа "Свод" и "Категории"
Мне нужно чтоб макрос искал в листе "Категории" по полям и присваивал категории в соответствии с наименованием (столбца А) в листе "Свод" и вставлял информацию в столбец В категории.

@КостяФедореев · 10.02.2021, 11:30

Admnis, а чем ВПР вам не подошел?

@Admnis · 10.02.2021, 11:48 **[ТС]**

Нужен именно макрос, так как лист категории подгружается другим макросом. Все время меняются строки. Поэтому нужно чтоб искал.

@КостяФедореев · 10.02.2021, 14:35

Admnis, Проверьте

Visual Basic

Public Sub www()
Dim arr1
Dim arr2
Set SV = ThisWorkbook.Sheets("СВОД")
Set KT = ThisWorkbook.Sheets("категории")
last_row1 = SV.Cells(SV.Rows.Count, "A").End(xlUp).Row
arr1 = SV.Range(SV.Cells(2, 1), SV.Cells(last_row1, 2))
last_row2 = KT.Cells(KT.Rows.Count, "A").End(xlUp).Row
arr2 = KT.Range(KT.Cells(2, 1), KT.Cells(last_row2, 3))
ReDim arr3(1 To UBound(arr1), 1 To 1)
For i = 1 To UBound(arr1)
    For j = 1 To UBound(arr2)
        If Replace(arr2(j, 1), """", "") = arr1(i, 1) Then
        arr3(i, 1) = arr2(j, 3)
        End If
    Next j
Next i
Sheets("СВОД").Cells(2, "B").Resize(UBound(arr1), 1) = arr3
End Sub

@Admnis · 10.02.2021, 15:18 **[ТС]**

Срабатывает как то странно, не на все города раскидывает, очень много пустых остается.

@КостяФедореев · 10.02.2021, 15:23

Admnis, У Вас данные не приведены к одному виду и какая закономерность там мне не известно, я увидел схожесть в присутствии кавычек и их отсутствии
например:
ОО №8600/0184 КИЦ Петровск-Забайкальский
и
ОО №8600/0184 КИЦ "Петровск-Забайкальский"
по этому критерию и сделал сравнение

@Admnis · 10.02.2021, 15:27 **[ТС]**

Вся беда в этом и есть. Файлы разные. Эта две выгрузки и они должны между собой сравниваться и присваиваться категории. выровнять в выгрузках не представляется возможным.
Есть ли возможность вот по таким параметрам искать 8600/0184 у каждого города есть 4/4 цифры

@КостяФедореев · 10.02.2021, 15:35

Admnis, Чуть позже посмотрю

@Narimanych · 10.02.2021, 18:34

Admnis,

Сообщение от Admnis

орода есть 4/4 цифры

не у всех.

Добавлено через 2 часа 47 минут
Admnis,
Вот пот номерам:

Кликните здесь для просмотра всего текста

Visual Basic

Sub MMM()
Set RR = CreateObject("VBScript.RegExp")
RR.Pattern = "\d+(-|_|/)* *\d*"
With Sheets("СВОД")
    LR1 = .Cells(Rows.Count, 1).End(xlUp).Row
    Set R1 = Range(.Cells(2, 1), .Cells(LR1, 4))
    arr1 = R1.Value
    For i = 1 To UBound(arr1)
        If RR.Execute(arr1(i, 1)).Count Then arr1(i, 4) = RR.Execute(arr1(i, 1)).Item(0)
    Next
End With
 
With Sheets("категории")
    LR2 = .Cells(Rows.Count, 1).End(xlUp).Row
    Set R2 = Range(.Cells(2, 1), .Cells(LR2, 4))
    arr2 = R2.Value
    For i = 1 To UBound(arr2)
        If RR.Execute(arr2(i, 1)).Count Then arr2(i, 4) = RR.Execute(arr2(i, 1)).Item(0)
    Next
    R2.Value = arr2
End With
 
For i = 1 To UBound(arr1)
    arr1(i, 4) = Trim(Replace(arr1(i, 4), "_", "/"))
    For j = 1 To UBound(arr2)
      
    If arr1(i, 4) = Trim(arr2(j, 4)) Then arr1(i, 2) = arr2(j, 3)
      
    Next
    'arr1(i, 4) = ""
Next
R1.Value = arr1
 
End Sub

@КостяФедореев Часто онлайн 864 / 579 / 263 Регистрация: 09.01.2017 Сообщений: 1,951
	10.02.2021, 11:30	2
	Admnis, а чем ВПР вам не подошел? 0

@Admnis 0 / 0 / 0 Регистрация: 09.09.2018 Сообщений: 25
	10.02.2021, 11:48 [ТС]	3
	Нужен именно макрос, так как лист категории подгружается другим макросом. Все время меняются строки. Поэтому нужно чтоб искал. 0

@Admnis 0 / 0 / 0 Регистрация: 09.09.2018 Сообщений: 25
	10.02.2021, 15:18 [ТС]	5
	Срабатывает как то странно, не на все города раскидывает, очень много пустых остается. 0

@КостяФедореев Часто онлайн 864 / 579 / 263 Регистрация: 09.01.2017 Сообщений: 1,951
	10.02.2021, 15:23	6
	Admnis, У Вас данные не приведены к одному виду и какая закономерность там мне не известно, я увидел схожесть в присутствии кавычек и их отсутствии например: ОО №8600/0184 КИЦ Петровск-Забайкальский и ОО №8600/0184 КИЦ "Петровск-Забайкальский" по этому критерию и сделал сравнение 0

@Admnis 0 / 0 / 0 Регистрация: 09.09.2018 Сообщений: 25
	10.02.2021, 15:27 [ТС]	7
	Вся беда в этом и есть. Файлы разные. Эта две выгрузки и они должны между собой сравниваться и присваиваться категории. выровнять в выгрузках не представляется возможным. Есть ли возможность вот по таким параметрам искать 8600/0184 у каждого города есть 4/4 цифры 0

@КостяФедореев Часто онлайн 864 / 579 / 263 Регистрация: 09.01.2017 Сообщений: 1,951
	10.02.2021, 15:35	8
	Admnis, Чуть позже посмотрю 0

	10.02.2021, 18:34