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

[Toffifee]

Есть отчет, требуется чтоб данные с первого листа "Бюджет", переносились на лист "1С И ПРОЧЕЕ" в табличку "РАСХОДЫ 51 СЧЁТ (РС)".
Причем только вот эти (выделены красным в приложенном файле):
1. Аренда помещения
2. ГСМ
3. Связь
4. Канц. Товары
5. Реклама
Проблема в чем - заноситься они должны по городам, и только в те, где стоит "ЦМ". А "МСБ" и "Анкор" надо пропускать. И ещё, если добавили строку с названием нового города в лист "Бюджет", то следовательно добавился столбик с названием города в лист "1С И ПРОЧЕЕ"(добавляют вркчную и там и там). Как же сделать так, чтоб макрос это распозновал и не путал куда вставлять данные?? Иначе ведь он получается будет путать ячейки и данные будут смещаться.... Ну и в конце "ИТОГО конечный бюджет" должен записаться в "ИТОГО".
Файл приложила.
Ежедневный отчет.rar

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

[Hugo121]

Сделать можно, но муторно.
И первым делом нужно таблицу соответствия составить, ибо как соотнести например эти названия?

Астрахань
Астрахань- Доп.офис2
Астрахань- Доп.офис3
Астрахань- Доп.офис4
Астрахань - Доп.офис5
Астрахань - Камызяк

и

Астрахань
Астрахань2
Астрахань3
Астрахань4
Астрахань-Красный Яр
Астрахань-Харабали

Далее для каждого названия из листа "Бюджет" ищем соответствие, потом ищем find/findnext соответствие соответствию в седьмой строке другой таблицы, проверяем, что ниже есть ЦМ.
Как всё сошлось - дело техники перекинуть данные из строки одного листа в столбец другого.
Добавление городов мешать не будет.
Но делать неинтересно. А главное - нет таблицы соответствия названий.
Или приведите в соответствие сами названия на обоих листах.

P.S.
А лучше бы ввести какие-нибудь ID номера, которые прописать в свободные ячейки нужного столбца в 1С, можно цветом фона.
А в "Бюджете" можно где-то в столбце BD например прописать, хотя лучше в B и остальное сдвинуть.
Тогда таблица соответствия не нужна - при появлении новых городов придумаете/добавите новый ID, по которому искать.

[Toffifee]

Не могу переименовать столбцы в таблице. Я скинула всего 2 листа, остальные удалила. Там всё макросами подвязано, мне придется править тонну макросов, и тонну формул, это нереально. Проще составить таблицу соответствий....
Это отдельным каким то файлом сделать? В каком формате это должно быть? Я сделаю.

[Hugo121]

Проще в этом же файле на отдельном листе в два столбика соответствия названий забить.
Потом в начале кода берём этот список в Dictionary (keys/items) и циклом по одному листу берём Item из словаря, ищем в другом листе и т.д.
Но мне пока код писать/отлаживать некогда, извините.

P.S. Этот лист соответствий может быть скрытым/суперскрытым.

[Hugo121]

Вот почти готово, копирование дописать. Я пока убегаю...
Список соответствий на листе под кодовым именем equivalent

Option Explicit

Sub Perenos()
Dim a(), oDict As Object, i&, x As Range, iFirstAddress$

With [equivalent]
    a = .Range("A1:B" & .Range("B" & .Rows.Count).End(xlUp).Row).Value
End With

    Set oDict = CreateObject("Scripting.Dictionary")
    oDict.CompareMode = vbTextCompare

    For i = 1 To UBound(a): oDict.Item(a(i, 1)) = a(i, 2): Next

With [Лист1]
    a = .Range("B6:AM" & .Range("AM" & .Rows.Count).End(xlUp).Row - 1).Value
End With


With [Лист47]
For i = 1 To UBound(a)
If oDict.Exists(a(i, 1)) Then
Set x = .Rows(7).Find(oDict.Item(a(i, 1)), LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)

If Not x Is Nothing Then 'если нашли

    iFirstAddress = x.Address 'запоминаем адрес
            
    Do 'цикл
        Set x = .Rows(7).FindNext(x) 'ищем дальше
        If x.Offset(1, 0) = "ЦМ" Then
        'тут делаем дело с найденным, копируем значения
        'из массива на лист в найденные столбцы
        Debug.Print x.Address ' для проверки
        End If
    'ищем дальше, пока не вернёмся к первому найденному
    Loop While Not x Is Nothing And x.Address <> iFirstAddress
    
End If

End If

Next
End With

'это для проверки, закомментировать
'With Workbooks.Add.Worksheets(1)
'.Range("A1").Resize(oDict.Count) = Application.Transpose(oDict.keys)
'.Range("B1").Resize(oDict.Count) = Application.Transpose(oDict.items)
'End With

End Sub

P.S. Ещё бы надо в новый файл вывести список ненайденных городов - вдруг появятся новые, не занесённые в список, или занесённые, но отсутствующие на втором листе.
Но это уже последний штрих, когда всё будет готово

[Hugo121]

Вообще-то одну строку не дописал, всё копирование вот оно:
For ii = 13 To 17: .Cells(ii, x.Column).Value = a(i, ii + 21): Next


Поясню по использованию словаря - это предусматривает, что соответствие для каждого наиименования одно.
Т.е. не может быть
Альметьевск-Доп.офис 2 Альметьевск2
и
Альметьевск-Доп.офис 2 Альметьевск-офис2
В таком случае в словаре окажется только последняя пара
Альметьевск-Доп.офис 2 Альметьевск-офис2

Если возможны несколько вариантов соответствий (что бывает на практике, например один раз так, другой иначе), то словарь не годится.
Тогда перебирайте массивы "a" цикл в цикле (только имена этим разным по содержимому массивам "a" тогда нужно дать разные )
Т.е. взяли одно значение, нашли первое соответствие, поискали по ряду, нашли/ненашли, взяли второе... Совпадение будет с одним из соответствий (по логике ведения таблицы), но не известно, с каким.
Это если возможны разные варианты соответствий!

Ещё, для экономии ресурсов, стоит исходные данные брать в два массива - в один диапазон столбца B с городами, в другой AI:AM с данными.
В два массива параллельно, тогда анализируем данные одного, а копируем из другого по тому же индексу. Так не придётся держать в памяти лишние данные C:AH.
Я не стал тут этого делать, чтоб Вам проще было разобраться. Советую понять код, ибо Вам потом его исправлять, когда что-то изменится
Файл чуть подсократил, запускать макрос Perenos() по Alt+F8 или из редактора. Или кнопку добавьте.
Вывод в лог ненайденных пока не делал.
Лист equivalent можно после заполнения скрыть или ОченьСкрыть, чтоб глаза не мозолил и руки не чесал

P.S. Список соответствий в решении естественно неполный...

[Toffifee]

Моя челюсть на полу....
Сказать спасибо это ничего не сказать....... я в шоке!
Спасибо, разберусь с кодом, почитаю, посмотрю что к чему, список соответствий допишу... вопросы будут - задам ))))

[Hugo121]

На самом деле ничего особо сложного нет, если посмотреть на задачу в общем:
1. Определяемся, что и где ищем.
2. Когда нашли - копируем данные из "что" в "где".
Остальное дело техники...

Да, я там случайно слишком много отрезал снизу - строку с формулами "ИТОГО" стоило оставить
Ну Вы всё равно будете код и лист соответствий в свой файл добавлять, так что это ничего.
Обращаю ещё раз внимание на CodeName листа equivalent ! Ищется не название листа, которое на ярлыке, а CodeName.
Впрочем и с другими листами так же - названия и расположение роли не играют. Так безопаснее.

[Toffifee]

Вот, создала я справочник соответствий городов. Работает. Посмотрела код, вроде даже поняла его. Вот тут доделанная таблица соответствий:
Ежедневный отчет 1.0.rar

Теперь у меня другой вопрос. Я до этого тему создавала, вот эту: http://www.programmersforum.ru/showthread.php?t=151417. Значит, надо добавить данный код в тот, который переносит листы. То есть получается будет так, что он листы перенес, а потом уже значения подставил? Тогда получается таблица соответствий городов должна быть в книге "Отчет_за_месяц", ну то есть в той, из которой листы копируются? Или его тоже копировать вместе с теми 3-мя листами???
Заранее спасибо за ответ!

[Hugo121]

А почему в таблице соответствий дыры?
В случае с Абакан и другими такими код будет искать даже не знаю что, нужно проверять... Это нужно исправить - или заполнить пустоту, или стереть эти строки, или в коде ставить проверку.

По вопросу - код берёт таблицу из файла, где он сам находится. В принципе - можно прописать, что таблицу брать из одного определённого файла, где вообще больше ничего нет. Можно по разному сделать, как Вам удобнее, смотрите сами.