0 / 0 / 0
Регистрация: 09.09.2018
Сообщений: 25
1
Excel

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

10.02.2021, 11:20. Показов 462. Ответов 8
Метки нет (Все метки)

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

Помощь в написании контрольных, курсовых и дипломных работ здесь.

Вложения
Тип файла: xlsx Категории.xlsx (36.0 Кб, 9 просмотров)
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
10.02.2021, 11:20
Ответы с готовыми решениями:

Перенос данных с одного листа на другой
Добрый день! В книге два листа лист 1 с данными, лист 2 в него надо перенести некоторые данные....

Перенос данных с одного листа на другой
Добрый день. Существует два листа, в них хранятся данные. В первый лист мы загружаем обновлённую...

Перенос данных из одного листа на другой
Всем доброго времени суток, господа Проблема вот в чём: есть рабочая книга, в ней два листа. На...

Перенос данных из одного листа Excel в другой
Добрый день Уважаемые!!! Обращаюсь к Вам с такой помощью. Необходимо чтобы при открытии листа...

8
631 / 421 / 188
Регистрация: 09.01.2017
Сообщений: 1,391
10.02.2021, 11:30 2
Admnis, а чем ВПР вам не подошел?
0
0 / 0 / 0
Регистрация: 09.09.2018
Сообщений: 25
10.02.2021, 11:48  [ТС] 3
Нужен именно макрос, так как лист категории подгружается другим макросом. Все время меняются строки. Поэтому нужно чтоб искал.
0
631 / 421 / 188
Регистрация: 09.01.2017
Сообщений: 1,391
10.02.2021, 14:35 4
Admnis, Проверьте
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
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
0
0 / 0 / 0
Регистрация: 09.09.2018
Сообщений: 25
10.02.2021, 15:18  [ТС] 5
Срабатывает как то странно, не на все города раскидывает, очень много пустых остается.
0
631 / 421 / 188
Регистрация: 09.01.2017
Сообщений: 1,391
10.02.2021, 15:23 6
Admnis, У Вас данные не приведены к одному виду и какая закономерность там мне не известно, я увидел схожесть в присутствии кавычек и их отсутствии
например:
ОО №8600/0184 КИЦ Петровск-Забайкальский
и
ОО №8600/0184 КИЦ "Петровск-Забайкальский"
по этому критерию и сделал сравнение
0
0 / 0 / 0
Регистрация: 09.09.2018
Сообщений: 25
10.02.2021, 15:27  [ТС] 7
Вся беда в этом и есть. Файлы разные. Эта две выгрузки и они должны между собой сравниваться и присваиваться категории. выровнять в выгрузках не представляется возможным.
Есть ли возможность вот по таким параметрам искать 8600/0184 у каждого города есть 4/4 цифры
0
631 / 421 / 188
Регистрация: 09.01.2017
Сообщений: 1,391
10.02.2021, 15:35 8
Admnis, Чуть позже посмотрю
0
1965 / 1343 / 630
Регистрация: 23.03.2015
Сообщений: 4,378
10.02.2021, 18:34 9
Admnis,
Цитата Сообщение от Admnis Посмотреть сообщение
орода есть 4/4 цифры
не у всех.

Добавлено через 2 часа 47 минут
Admnis,
Вот пот номерам:
Кликните здесь для просмотра всего текста

Visual Basic
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
26
27
28
29
30
31
32
33
34
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
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
10.02.2021, 18:34

Перенос данных с одного листа на другой в Excel
Доброго времени суток! Голову сломал, не найти полезной инфы. Есть лист "1" - дано (вписываем от...

Перенос данных с одного листа на другой в Excel
На первом листе есть данные. При активации следующих листов проверить наличие данных в этих листах....

Перенос данных в Excel c одного листа на другой
Возникла необходимость поковыряться в Excel, раньше на VBA не программировал, поэтому рассчитываю...

Перенос данных из одного листа в другой
Добрый вечер! Такое дело: у меня есть 5 листов (1-й, 2-й, 3-й, 4-й кварталы и "общий"). Выглядят...

Перенос данных с одного листа на другой
Форум привет. Подскажите, как это загуглить или сделать. Дано: таблица с данными, пополняется...

Перенос данных с одного листа на другой
Такая проблема, на одном листе записаны автомобили и их гос.номера. нужно, чтобы на другом листе,...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
9
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2021, vBulletin Solutions, Inc.