Доброго времени форумчане. Помогите решить проблему. До этого как то обходилась подстановочкой для своих требований. Но сегодня столкнулась с этим) Макрос нашла в теме, решение предложила РElenа, он очень классный, не большой, но я что то делаю не так. У меня он копирует из открытой книги в закрытую, но задваивает значения (затраивание устранила) ) Посмотрите пожалуйста файлик.
Доброго времени форумчане. Помогите решить проблему. До этого как то обходилась подстановочкой для своих требований. Но сегодня столкнулась с этим) Макрос нашла в теме, решение предложила РElenа, он очень классный, не большой, но я что то делаю не так. У меня он копирует из открытой книги в закрытую, но задваивает значения (затраивание устранила) ) Посмотрите пожалуйста файлик.Olena
Я уже писала в личке, что в макросе не предусмотрена проверка на повторы, то есть он просто копирует все строки из одного файла и дописывает к уже имеющимся в другой. И не совсем понятно, зачем цикл по листам, если лист только один "Сбор", может, поэтому и задваивал?
Я уже писала в личке, что в макросе не предусмотрена проверка на повторы, то есть он просто копирует все строки из одного файла и дописывает к уже имеющимся в другой. И не совсем понятно, зачем цикл по листам, если лист только один "Сбор", может, поэтому и задваивал?Pelena
Всем доброго времени. Подскажите пожалуйста где почитать или образец, хочу сама найти решение. Решение Елены прекрасно работает, я даже его немного дополнила. Только вот при тестирование поняла, что мне нужна еще одна "функция" Волнуюсь от случайного не нужного копирования. Вдруг будет "совпадение" а именно, это что-то своего рода архив, и вот вдруг забуду главную таблицу очистить, сработает таймер записи и могу "задублировать" данные. Подскажите пожалуйста, где бы мне почитать, про сравнение строк перед копирование. 1.Сравнение старых строк вдруг такое будет и они отличаться будут по какому то признаку то перезаписало их. 2. Если они полностью одинаковы - пропустить и дополнило только новыми. Что я могу уже сделать. Проверить условие совпадения дат сегодняшняя с последней датой в закрытой книге столбец I [vba]
Код
" If data("dd.mm.yyyy")> Конечная.Sheets("Сбор").Range("I1").CurrentRegion.Rows.Count
[/vba] (могла написать с ошибкой, не проверяла, набросок) так как у меня там даты в основном главный критерий. Этот метод ка по мне не очень красивый и верный. Хотела бы всю строку проверять, но вот с библиотеками я не умею работать от слова совсем. Почему прошу дать наводку, а не решить проблему, хочу сама разобраться. Разберусь раз, меньше постов тут создам). Не справлюсь, попрошу помощи Всем хороших выходных)
Всем доброго времени. Подскажите пожалуйста где почитать или образец, хочу сама найти решение. Решение Елены прекрасно работает, я даже его немного дополнила. Только вот при тестирование поняла, что мне нужна еще одна "функция" Волнуюсь от случайного не нужного копирования. Вдруг будет "совпадение" а именно, это что-то своего рода архив, и вот вдруг забуду главную таблицу очистить, сработает таймер записи и могу "задублировать" данные. Подскажите пожалуйста, где бы мне почитать, про сравнение строк перед копирование. 1.Сравнение старых строк вдруг такое будет и они отличаться будут по какому то признаку то перезаписало их. 2. Если они полностью одинаковы - пропустить и дополнило только новыми. Что я могу уже сделать. Проверить условие совпадения дат сегодняшняя с последней датой в закрытой книге столбец I [vba]
Код
" If data("dd.mm.yyyy")> Конечная.Sheets("Сбор").Range("I1").CurrentRegion.Rows.Count
[/vba] (могла написать с ошибкой, не проверяла, набросок) так как у меня там даты в основном главный критерий. Этот метод ка по мне не очень красивый и верный. Хотела бы всю строку проверять, но вот с библиотеками я не умею работать от слова совсем. Почему прошу дать наводку, а не решить проблему, хочу сама разобраться. Разберусь раз, меньше постов тут создам). Не справлюсь, попрошу помощи Всем хороших выходных)Olena
Всем добрый вечер. Поиски не увенчались успехом, ни "подходящего" варианта, ни чего для "легкого ознакомления" не нашла, написано много, только для меня это не подсильна задача Библиотеки, массивы, как его туда "загнать" Видать задачка не из простых) Может у кого то из форумчан есть относительно готовое решение под мою задачу, я не отказалась бы от помощи) Всем хорошего вечера)
Всем добрый вечер. Поиски не увенчались успехом, ни "подходящего" варианта, ни чего для "легкого ознакомления" не нашла, написано много, только для меня это не подсильна задача Библиотеки, массивы, как его туда "загнать" Видать задачка не из простых) Может у кого то из форумчан есть относительно готовое решение под мою задачу, я не отказалась бы от помощи) Всем хорошего вечера)Olena
ХМ, нашла подходящий макрос, но вот подправить не могу, так как не знаю, как переписать Открыть файл в сети , прочитать лист, сравнить с листом ( они идентичны по структуре, разные по наполнению) и записать не совпадающие в низ и перезаписать, совпадающие (т.к. иногда будет кое что меняться.) [vba]
Код
Sub tabsumm() On Error GoTo какашка Dim tb1, tb2, rez, wb, f, k, lr(2), strS, strD, str, tr, arr(), nofind(), ActR, temp wb = ActiveWorkbook.Name tb1 = "table1" tb2 = "table2" rez = "результат" lr(1) = Workbooks(wb).Sheets(tb1).Cells(Rows.Count, 1).End(xlUp).Row ReDim arr(2, lr(1)) ReDim nofind(lr(1)) lr(2) = Workbooks(wb).Sheets(tb2).Cells(Rows.Count, 1).End(xlUp).Row Workbooks(wb).Sheets(rez).Cells.Clear For f = 2 To lr(1) str = Workbooks(wb).Sheets(tb1).Cells(f, 3).Value Workbooks(wb).Sheets(tb2).Select Workbooks(wb).Sheets(tb2).Cells(2, 1).Select tr = 2 Workbooks(wb).Sheets(tb2).Cells.Find(What:=str, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate ActR = ActiveCell.Row If ActR > tr Then strS = "A" & f & ":C" & f arr(1, f) = Workbooks(wb).Sheets(tb1).Range(strS).Value strD = "C" & ActR & ":Q" & ActR arr(2, f) = Workbooks(wb).Sheets(tb2).Range(strD).Value nofind(f) = 1 Else nofind(f) = 0 End If Next f f = f - 3 tr = 2 strS = "A1:C1" strD = "A1:C1" temp = Workbooks(wb).Sheets(tb1).Range(strS).Value Workbooks(wb).Sheets(rez).Range(strD).Value = temp strS = "C1:Q1" strD = "D1:R1" temp = Workbooks(wb).Sheets(tb2).Range(strS).Value Workbooks(wb).Sheets(rez).Range(strD).Value = temp Workbooks(wb).Sheets(rez).Cells.EntireColumn.AutoFit Workbooks(wb).Sheets(rez).Cells.WrapText = False
For k = 0 To f If nofind(k + 2) = 1 Then strS = "A" & tr & ":C" & tr strD = "D" & tr & ":R" & tr Workbooks(wb).Sheets(rez).Range(strS).Value = arr(1, k + 2): Workbooks(wb).Sheets(rez).Range(strD).Value = arr(2, k + 2): tr = tr + 1 End If Next k
tr = tr + 2 strS = "A1:Q1" temp = Workbooks(wb).Sheets(tb1).Range(strS).Value strS = "A" & tr & ":Q" & tr Workbooks(wb).Sheets(rez).Range(strS).Value = temp Workbooks(wb).Sheets(rez).Cells.EntireColumn.AutoFit Workbooks(wb).Sheets(rez).Cells.WrapText = False tr = tr + 1 For k = 0 To f If nofind(k + 2) = 0 Then strS = "A" & k + 2 & ":Q" & k + 2 strD = "A" & tr & ":Q" & tr Workbooks(wb).Sheets(rez).Range(strD).Value = Workbooks(wb).Sheets(tb1).Range(strS).Value: tr = tr + 1 End If Next k Workbooks(wb).Sheets(rez).Cells.EntireColumn.AutoFit Workbooks(wb).Sheets(rez).Cells.WrapText = False Exit Sub какашка: If Err = 91 Then Resume Next MsgBox Err & " - " & Err.Description, vbCritical, "Ошибка" End Sub
ХМ, нашла подходящий макрос, но вот подправить не могу, так как не знаю, как переписать Открыть файл в сети , прочитать лист, сравнить с листом ( они идентичны по структуре, разные по наполнению) и записать не совпадающие в низ и перезаписать, совпадающие (т.к. иногда будет кое что меняться.) [vba]
Код
Sub tabsumm() On Error GoTo какашка Dim tb1, tb2, rez, wb, f, k, lr(2), strS, strD, str, tr, arr(), nofind(), ActR, temp wb = ActiveWorkbook.Name tb1 = "table1" tb2 = "table2" rez = "результат" lr(1) = Workbooks(wb).Sheets(tb1).Cells(Rows.Count, 1).End(xlUp).Row ReDim arr(2, lr(1)) ReDim nofind(lr(1)) lr(2) = Workbooks(wb).Sheets(tb2).Cells(Rows.Count, 1).End(xlUp).Row Workbooks(wb).Sheets(rez).Cells.Clear For f = 2 To lr(1) str = Workbooks(wb).Sheets(tb1).Cells(f, 3).Value Workbooks(wb).Sheets(tb2).Select Workbooks(wb).Sheets(tb2).Cells(2, 1).Select tr = 2 Workbooks(wb).Sheets(tb2).Cells.Find(What:=str, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate ActR = ActiveCell.Row If ActR > tr Then strS = "A" & f & ":C" & f arr(1, f) = Workbooks(wb).Sheets(tb1).Range(strS).Value strD = "C" & ActR & ":Q" & ActR arr(2, f) = Workbooks(wb).Sheets(tb2).Range(strD).Value nofind(f) = 1 Else nofind(f) = 0 End If Next f f = f - 3 tr = 2 strS = "A1:C1" strD = "A1:C1" temp = Workbooks(wb).Sheets(tb1).Range(strS).Value Workbooks(wb).Sheets(rez).Range(strD).Value = temp strS = "C1:Q1" strD = "D1:R1" temp = Workbooks(wb).Sheets(tb2).Range(strS).Value Workbooks(wb).Sheets(rez).Range(strD).Value = temp Workbooks(wb).Sheets(rez).Cells.EntireColumn.AutoFit Workbooks(wb).Sheets(rez).Cells.WrapText = False
For k = 0 To f If nofind(k + 2) = 1 Then strS = "A" & tr & ":C" & tr strD = "D" & tr & ":R" & tr Workbooks(wb).Sheets(rez).Range(strS).Value = arr(1, k + 2): Workbooks(wb).Sheets(rez).Range(strD).Value = arr(2, k + 2): tr = tr + 1 End If Next k
tr = tr + 2 strS = "A1:Q1" temp = Workbooks(wb).Sheets(tb1).Range(strS).Value strS = "A" & tr & ":Q" & tr Workbooks(wb).Sheets(rez).Range(strS).Value = temp Workbooks(wb).Sheets(rez).Cells.EntireColumn.AutoFit Workbooks(wb).Sheets(rez).Cells.WrapText = False tr = tr + 1 For k = 0 To f If nofind(k + 2) = 0 Then strS = "A" & k + 2 & ":Q" & k + 2 strD = "A" & tr & ":Q" & tr Workbooks(wb).Sheets(rez).Range(strD).Value = Workbooks(wb).Sheets(tb1).Range(strS).Value: tr = tr + 1 End If Next k Workbooks(wb).Sheets(rez).Cells.EntireColumn.AutoFit Workbooks(wb).Sheets(rez).Cells.WrapText = False Exit Sub какашка: If Err = 91 Then Resume Next MsgBox Err & " - " & Err.Description, vbCritical, "Ошибка" End Sub
Всем доброе утро. Прошу помочь в завершении макроса по "удалению/перезаписанию" дублей. Создала кое что подобное, но увы немного не так работает. Что я делала или не правильно сделала ) - записала макрорекордером удаление дублей для меня єто 40% успеха! - вставила его в макрос который копирует весь лист и макрос с макрорекордера удаляет дубли на "промежуточном листе" - муж нашел где то макрос и немного подправив его я вставила в макрос как ссылку и этот макрос как бы и должен из всех данных в файле 1234 (в него загружаю с сборщика) лист "ЕКСП" и из этого листа макрос записывает без дублей строки в лист "Сбор" файла 1234 (в него загружаю с сборщика. НО, во всей строке будет меняться только пару ячеек и самый важный столбец это AN (Выполнение). принцып работы хочу получить таков: Делаю "експорт" из 1234 (Главный файл) в файл 1234((в него загружаю с сборщика), там макрос должен распознать дубли так как они будут неизбежно ( каждый день, резервная копия) и удалить из, через время будет снова резервная копия и какие то строки изменяться именно по ктолбцу AN, вот и надо будет перезаписать макросу эту строку целиком и внести изменение по столбцу AN. Сейчас же макрос вносит данные, удаляет дубли, но увы по стоблцу AN он видит как новую строку. Если есть возможность из этого чуда что мы "написали" сделать хоть что то) промежуточный лист "ЕКСП" не обязателен, я его использую для "массива всего" что бы отобрать дубликаты для удаления. Может и не верно конечно. хотя конечно не верно) Всем спасибо. Хорошего дня.
Всем доброе утро. Прошу помочь в завершении макроса по "удалению/перезаписанию" дублей. Создала кое что подобное, но увы немного не так работает. Что я делала или не правильно сделала ) - записала макрорекордером удаление дублей для меня єто 40% успеха! - вставила его в макрос который копирует весь лист и макрос с макрорекордера удаляет дубли на "промежуточном листе" - муж нашел где то макрос и немного подправив его я вставила в макрос как ссылку и этот макрос как бы и должен из всех данных в файле 1234 (в него загружаю с сборщика) лист "ЕКСП" и из этого листа макрос записывает без дублей строки в лист "Сбор" файла 1234 (в него загружаю с сборщика. НО, во всей строке будет меняться только пару ячеек и самый важный столбец это AN (Выполнение). принцып работы хочу получить таков: Делаю "експорт" из 1234 (Главный файл) в файл 1234((в него загружаю с сборщика), там макрос должен распознать дубли так как они будут неизбежно ( каждый день, резервная копия) и удалить из, через время будет снова резервная копия и какие то строки изменяться именно по ктолбцу AN, вот и надо будет перезаписать макросу эту строку целиком и внести изменение по столбцу AN. Сейчас же макрос вносит данные, удаляет дубли, но увы по стоблцу AN он видит как новую строку. Если есть возможность из этого чуда что мы "написали" сделать хоть что то) промежуточный лист "ЕКСП" не обязателен, я его использую для "массива всего" что бы отобрать дубликаты для удаления. Может и не верно конечно. хотя конечно не верно) Всем спасибо. Хорошего дня.Olena
На приложенных пустых файлах Ваши макросы не работают. Почему в макросе данные начинаются со столбца С, а в файле - со столбца В? Заполните пару строк произвольными данными, чтобы макрос хотя бы заработал
На приложенных пустых файлах Ваши макросы не работают. Почему в макросе данные начинаются со столбца С, а в файле - со столбца В? Заполните пару строк произвольными данными, чтобы макрос хотя бы заработалPelena
"Черт возьми, Холмс! Но как??!!" Ю-money 41001765434816
На приложенных пустых файлах Ваши макросы не работают.
Что то я совсем запуталась. По новому переделала, и снова какая то бяка. - Не работало - оказалось, что все столбцы и названия колонок обязательны - иначе ошибка . Устранила. Но дальше прям ерунда какая то, вот на работе компьютер наш - на нем файл работал все хорошо. Домой принесла, протестировала только что, и что я вижу. Макрос как то не так работает как я ожидала) Сейчас если посмотреть в Файле 1234 лист "ЕКСП" он имеет 3 строки данных, но в лист СБОР перенеслось всего 2 строки. И сейчас я в ступоре. Если мы добавим еще строку в Лист ЕСКП, тогда добавиться 3я строка, с каким то запозданием все это происходит как будто Rows (-1). На рабочем ПК такого не было. Дома у меня 7й офис, может в этом проблема. Ура нашла проблему из описания выше, исправила. Но по прежнему не перезаписывает. Я немного правда макрос дописывала еще на работе, он немного отличается от предыдущих что скидывала раньше. Я добавила проверки на каждый столбец, но до конца увы не придумаю. Посмотрите пожалуйста.
На приложенных пустых файлах Ваши макросы не работают.
Что то я совсем запуталась. По новому переделала, и снова какая то бяка. - Не работало - оказалось, что все столбцы и названия колонок обязательны - иначе ошибка . Устранила. Но дальше прям ерунда какая то, вот на работе компьютер наш - на нем файл работал все хорошо. Домой принесла, протестировала только что, и что я вижу. Макрос как то не так работает как я ожидала) Сейчас если посмотреть в Файле 1234 лист "ЕКСП" он имеет 3 строки данных, но в лист СБОР перенеслось всего 2 строки. И сейчас я в ступоре. Если мы добавим еще строку в Лист ЕСКП, тогда добавиться 3я строка, с каким то запозданием все это происходит как будто Rows (-1). На рабочем ПК такого не было. Дома у меня 7й офис, может в этом проблема. Ура нашла проблему из описания выше, исправила. Но по прежнему не перезаписывает. Я немного правда макрос дописывала еще на работе, он немного отличается от предыдущих что скидывала раньше. Я добавила проверки на каждый столбец, но до конца увы не придумаю. Посмотрите пожалуйста.Olena
Спасибо большое, все супер работает. Протестировала, думаю все будет супер. Мы редко в другие столбцы что то вносим/изменям, "руками просмотрим". Еще раз спасибо) Я вам в Л.С. написала) Всем хорошего дня)
Спасибо большое, все супер работает. Протестировала, думаю все будет супер. Мы редко в другие столбцы что то вносим/изменям, "руками просмотрим". Еще раз спасибо) Я вам в Л.С. написала) Всем хорошего дня)Olena