Объединение показаний из разных файлов в таб-цу одного файла - Страница 2

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

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

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Объединение показаний из разных файлов в таб-цу одного файла (Формулы/Formulas)

Объединение показаний из разных файлов в таб-цу одного файла

DrMini

Дата: Четверг, 19.07.2018, 15:22 | Сообщение № 21

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

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

Сообщений: 1649

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

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

Excel LTSC 2024 RUS

Цитата _Boroda_, 19.07.2018 в 15:14, в сообщении № 20 ()

Вы про это?

надо вместо

Код

.Unprotect

вписать:

Код

.Unprotect Password:="Пароль"

Ответить

_Boroda_

Дата: Четверг, 19.07.2018, 15:24 | Сообщение № 22

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

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

Сообщений: 16675

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

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

2003; 2007; 2010; 2013 RUS

Да, совершенно верно. Если лист заблокирован без пароля, то предыдущий код снимал защиту, а если с паролем, то для разблокировки этот пароль нужно ввести

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Ответить

DrMini

Дата: Четверг, 19.07.2018, 15:29 | Сообщение № 23

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

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

Сообщений: 1649

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

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

Excel LTSC 2024 RUS

_Boroda_, Спасибо. Всё работает. Низкий поклон.

Ответить

_Boroda_

Дата: Четверг, 19.07.2018, 15:30 | Сообщение № 24

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

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

Сообщений: 16675

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

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

2003; 2007; 2010; 2013 RUS

Да мне-то за что? Это все Николай

Ответить

DrMini

Дата: Четверг, 19.07.2018, 15:32 | Сообщение № 25

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

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

Сообщений: 1649

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

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

Excel LTSC 2024 RUS

Цитата _Boroda_, 19.07.2018 в 15:30, в сообщении № 24 ()

Да мне-то за что?

За скорость батенька. За скорость. СПАСИБО ещё раз.

Ответить

DrMini

Дата: Пятница, 31.08.2018, 12:32 | Сообщение № 26

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

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

Сообщений: 1649

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

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

Excel LTSC 2024 RUS

Всем доброго времени суток.
Помогите пожалуйста доработать макрос. Сделал через УФ выделение цветом в колонке "Лицевой счёт абонента" одинаковых лицевых счетов(бывает, что передают данные по 2 или некоторые аж по 5 раз за день. А файлы переименовывают). Но после каждого заполнения таблицы правило в УФ спускается к концу таблицы и приходится диапазон задавать вновь. Помогите решить эту проблему макросом. Спасибо заранее за любой ответ.

К сообщению приложен файл: 201808311.xlsm (31.9 Kb)

Ответить

_Boroda_

Дата: Пятница, 31.08.2018, 12:54 | Сообщение № 27

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

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

Сообщений: 16675

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

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

2003; 2007; 2010; 2013 RUS

Добавьте вниз макроса еще такой кусок
[vba]

Код

   ...
    Dim r1_
    With wsh
        .Cells.FormatConditions.Delete
        r1_ = .Cells(.Rows.Count, 4).End(3).Row
        .Cells(2, 4).Resize(r1_ - 1).FormatConditions.AddUniqueValues
        With .Cells(2, 4).Resize(r1_ - 1).FormatConditions(1)
            .DupeUnique = xlDuplicate
            .Font.Bold = True
            .Font.ColorIndex = 2
            .Interior.Color = 255
        End With
    End With
    Application.ScreenUpdating = True
End Sub

[/vba]

Убиваем все УФ на листе и рисуем его заново
Если всё УФ убивать не нужно, то можно только в столбце D
[vba]

Код

.Columns("D:D").FormatConditions.Delete

[/vba]

К сообщению приложен файл: 201808311_1.xlsm (33.2 Kb)

Ответить

DrMini

Дата: Пятница, 31.08.2018, 13:11 | Сообщение № 28

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

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

Сообщений: 1649

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

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

Excel LTSC 2024 RUS

СПАСИБО Александр. Всё отлично. hands

Ответить

DrMini

Дата: Суббота, 01.09.2018, 08:15 | Сообщение № 29

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

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

Сообщений: 1649

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

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

Excel LTSC 2024 RUS

И ещё раз всем доброго утра.
Помогите пожалуйста макросом убрать заливку цветом (сделать так, чтобы не было заливки) в колонке Наименование услуги, в зависимости от количества счетчиков воды. В исходном файле эта заливка удобна, а вот в итоговом она вообще не нужна. Файл не прикладываю. Он идентичен файлу в Сообщении 27

Сообщение отредактировал DrMini - Суббота, 01.09.2018, 08:16

Ответить

_Boroda_

Дата: Суббота, 01.09.2018, 14:29 | Сообщение № 30

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

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

Сообщений: 16675

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

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

2003; 2007; 2010; 2013 RUS

Еще в самый низ
[vba]

Код

...
            .Interior.Color = 255
        End With
        .Columns("E:E").Interior.Pattern = xlNone
    End With
    Application.ScreenUpdating = True
End Sub

[/vba]

К сообщению приложен файл: 201808311_2.xlsm (33.0 Kb)

Ответить

DrMini

Дата: Суббота, 01.09.2018, 20:46 | Сообщение № 31

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

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

Сообщений: 1649

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

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

Excel LTSC 2024 RUS

Спасибо. Всё отлично работает. Нижайший поклон.

Ответить

DrMini

Дата: Вторник, 04.09.2018, 10:57 | Сообщение № 32

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

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

Сообщений: 1649

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

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

Excel LTSC 2024 RUS

Добрый день форумчане.
Всё работало но перестало преобразовывать в колонке Месяц номер месяца (1-12) в название месяца.
Перестал работать макрос:
[vba]

Код

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$A$2" Then 'здесь меняется адрес изменяемого значения ячейки
        If Target = 1 Then Target = "Январь"
        If Target = 2 Then Target = "Февраль"
        If Target = 3 Then Target = "Март"
        If Target = 4 Then Target = "Апрель"
        If Target = 5 Then Target = "Май"
        If Target = 6 Then Target = "Июнь"
        If Target = 7 Then Target = "Июль"
        If Target = 8 Then Target = "Август"
        If Target = 9 Then Target = "Сентябрь"
        If Target = 10 Then Target = "Октябрь"
        If Target = 11 Then Target = "Ноябрь"
        If Target = 12 Then Target = "Декабрь"
    'тут можно добавить ещё ассоциации
    End If
End Sub

[/vba]
На листе Data. Помогите запихнуть его в модуль. Пробовал и так и эдак. Но я в VBA мягко говоря вааще не компетентен.
Помогите пожалуйста добить этот файл.

К сообщению приложен файл: 20180904.xlsm (32.4 Kb)

Сообщение отредактировал DrMini - Вторник, 04.09.2018, 11:02

Ответить

_Boroda_

Дата: Вторник, 04.09.2018, 11:15 | Сообщение № 33

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

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

Сообщений: 16675

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

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

2003; 2007; 2010; 2013 RUS

Добавьте вниз
[vba]

Код

        .Columns("E:E").Interior.Pattern = xlNone
        For i = 2 To r1_ Step 4
            .Cells(i, 1) = MonthName(.Cells(i, 1))
        Next i
    End With
    Application.ScreenUpdating = True
End Sub

[/vba]
Ну и объявите переменную i
А Worksheet_Change убейте

К сообщению приложен файл: 20180904_2.xlsm (30.1 Kb)

Ответить

StoTisteg

Дата: Вторник, 04.09.2018, 11:16 | Сообщение № 34

Группа: Авторы

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

Сообщений: 1161

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

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

Excel 2010

DrMini, честно говоря, я не уловил, а при чём тут "Объединение показаний из разных файлов в таб-цу одного файла"?

Интуитивно понятный код - это когда интуитивно понятно, что это код.

Ответить

DrMini

Дата: Вторник, 04.09.2018, 11:18 | Сообщение № 35

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

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

Сообщений: 1649

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

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

Excel LTSC 2024 RUS

Цитата StoTisteg, 04.09.2018 в 11:16, в сообщении № 34 ()

честно говоря, я не уловил, а при чём тут "Объединение показаний из разных файлов в таб-цу одного файла"?

Это было в самом начале и потихоньку из-за моей тупости переросло в это.

Ответить

DrMini

Дата: Вторник, 04.09.2018, 11:30 | Сообщение № 36

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

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

Сообщений: 1649

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

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

Excel LTSC 2024 RUS

Цитата _Boroda_, 04.09.2018 в 11:15, в сообщении № 33 ()

Добавьте вниз

Спасибо. Всё работает. yes

Ответить

DrMini

Дата: Четверг, 27.09.2018, 11:59 | Сообщение № 37

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

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

Сообщений: 1649

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

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

Excel LTSC 2024 RUS

Добрый день уважаемые форумчане.
Сегодня начал работать с файлами и выскакивает ошибка в коде
Run-time error '13':
Type mismatch
И выделяет жёлтым ошибку в строке кода

Код

.Cells(i, 1) = MonthName(.Cells(i, 1))

Помогите пожалуйста, кто может.

К сообщению приложен файл: 9588234.xlsm (30.5 Kb)

Сообщение отредактировал DrMini - Четверг, 27.09.2018, 12:01

Ответить

_Boroda_

Дата: Четверг, 27.09.2018, 12:07 | Сообщение № 38

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

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

Сообщений: 16675

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

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

2003; 2007; 2010; 2013 RUS

У Вас там и так названия месяцев буквами. Уберите последний цикл по i
[vba]

Код

        For i = 2 To r1_ Step 4
            .Cells(i, 1) = MonthName(.Cells(i, 1))
        Next i

[/vba]

Ответить

DrMini

Дата: Четверг, 27.09.2018, 12:40 | Сообщение № 39

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

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

Сообщений: 1649

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

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

Excel LTSC 2024 RUS

Цитата _Boroda_, 27.09.2018 в 12:07, в сообщении № 38 ()

У Вас там и так названия месяцев буквами.

Не все. В файле для передачи показаний месяц через УФ. Некоторые пишут буквами некоторые цифрами. И когда цифрами то надо преобразовать в слово. Прилагаю файл для показаний. Может я в нём, чего намутил.

К сообщению приложен файл: 0000000000.xls (38.0 Kb)

Ответить

_Boroda_

Дата: Четверг, 27.09.2018, 12:57 | Сообщение № 40

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

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

Сообщений: 16675

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

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

2003; 2007; 2010; 2013 RUS

Тогда так
[vba]

Код

        For i = 2 To r1_ Step 4
            If IsNumeric(.Cells(i, 1)) Then
                .Cells(i, 1) = MonthName(.Cells(i, 1))
            End If
        Next i

[/vba]
Или так
[vba]

Код

        On Error Resume Next
        For i = 2 To r1_ Step 4
            .Cells(i, 1) = MonthName(.Cells(i, 1))
        Next i
        On Error GoTo 0

[/vba]

Ответить

Страница 2 из 3
«
1
2
3
»