Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 След.
Золотой ключ. Создание поля уникальных значений.
 
Sanja,Если как-то не корректно ответил, то прошу прощения.
Nordheim, код выглядит приятно.
Золотой ключ. Создание поля уникальных значений.
 
Sanja, в случае вставки строки ключ уже не уникальный (дураковоустойчивость низкая), а блокировать доступ к 1ому столбцу это конено супер, я даже не думал об этом.
Изменено: Kor - 7 Авг 2019 19:50:56
Золотой ключ. Создание поля уникальных значений.
 
Jack Famous,Это я. из ДУБА =)
Золотой ключ. Создание поля уникальных значений.
 
торможу. Да goto действительно можно менять, но только 1 (2 нужен для пропуска строки, чтобы не определяла дубль как саму сравниваюмую строку).
При работе с данными критично иметь ключевое поле .т.к. с помощью него становится возможно связать несколько разнородных таблиц с минмальным колиеством общих полей.
Дата, Деньги, Вес, Название таблицы (откуда берем данные). Объединив все эти таблицы в одно большое полотно мы можем обращаться с этого полотна обратно в исходники. К сожадлению это уже не совсем отностится к теме сайта. Создание ключей для этого всего - это как раз работа с VBA. Конечно же описанные заачи должены решать базы данных. но блин их не всегда дают, а работать быстро здесь и сейас нужно. Стандартного способа создание клюевого поля я не нашел и мне пришлось писать код. при добавлении строк в середину ключ на прежних полях не меняется, то позволяет отследить изменения.
https://zen.yandex.ru/media/id/5c7acf0ae8513400b2ceeccf/power-bi-vajno-byt-poniatnym-5d00220342211f0... - это примерно то что должно полуиться в итоге.
Изменено: Kor - 7 Авг 2019 00:04:55 (орфография)
Золотой ключ. Создание поля уникальных значений.
 
Dima S, Благодарю =)
1) при использовании Power Bi, Power Query, Power Pivot даннная схема сильно упрощает жизнь. и поэтому все упаковано в динамическую таблицу  
2) Это просто пример и можно сделать не на активацию листа, а на любое событие книги.
3) Отсутствие пустот предполагает, что лезть туда уже не стоит и тратить на это ресурсы тоже сомнительно, хотя здесь есть над чем подумать. Имеются свои плюсы и минусы.
4) MsgBox легко удаляются, а так все работает без сбоев и существующая схема проявляет достаточную надежность, чтобы обеспечить создание уникальных полей.
5) выходить из цикла нельзя. т.к. останавливается дальнейшая проверка, а нужно только пропусить проверку текущей (бывшей пустой)  строки и запустить провеку с первой строки.

Так как это динамиеская таблица и работать с ней иногда опасно, то при открытии книги рекомендую отключать протягивание формул, дабы ненавредить данным, а то все данные перезатираются при легком движении руки (все прям весь столбец).
Изменено: Kor - 5 Авг 2019 23:29:08
Золотой ключ. Создание поля уникальных значений.
 
Этот код помогает создавать уникальные ключи во всех данных, но требует небольшого ручного управления.Буду рад конструктивной критике и дополнениям

Прикреплен файл с примером.
Макрос срабатывает при открытии листа книги.

Код
Private Sub Worksheet_Activate()
Dim e As String
ThisWorkbook.Activate            'строка не обязательна если работать в одной книги
Set Tab_1 = Лист1.ListObjects("Таблица1")

y = Tab_1.ListRows.Count         'посчитать количество строк в таблице
x = Tab_1.ListColumns.Count      'посчитать количество строк в таблице

a = Tab_1.ListColumns("Au_key").Range.Column  'Определить № столбца по имени столбца

e = "Уникальное название книги" & y
    For b = 1 To y
        If Tab_1.DataBodyRange(b, a) = "" Then
            Tab_1.DataBodyRange(b, a) = e
            
                For с = 1 To y

                    If Tab_1.DataBodyRange(с, a) = Tab_1.DataBodyRange(b, a) Then
                        MsgBox "найден дубликат"
                            For d = 1 To y
                                If Tab_1.DataBodyRange(d, a) = Tab_1.DataBodyRange(b, a) Then
                                    If d = b Then
                                     GoTo перенос2
                                    End If
                                    Tab_1.DataBodyRange(b, a) = e & "_" & d
                                    EXitFor
перенос2:
                                End If
                            Next d
                    End If
                Next с
        End If
    Next b
End Sub
Изменено: Kor - 6 Авг 2019 23:59:23 (заменил 1 GoTo на EXitFor)
Как работать с динамическими таблицами
 
Прошу Вас поделиться опытом, по теме.
Приведу пример работы с динамическими таблицами.
Если будут дополнения, то я буду только рад.
Код
Sub Динамиеские_таблцы()

ThisWorkbook.Activate            'строка не обязатель если работать в одной книги
Set Tab_1 = Лист1.ListObjects("Таблица1")

y = Tab_1.ListRows.Count         'посчитать колиесво строк в таблице
x = Tab_1.ListColumns.Count      'посчитать количесво столбец в таблице

'Tab_1.ListRows.Add           'Добавить новую строку
'Tab_1.ListRows(1).Delete     'удалить строку№
'Tab_1.ListRows(y).Delete     'удалить последнюю строку

'Tab_1.ListColumns.Add          'Добавить новый столбец
'Tab_1.ListColumns.Add 1        'Добавить новый столбец на позцию
'Tab_1.ListColumns(1).Delete    'Удалить колонку№
'Tab_1.HeaderRowRange.Select    'Выделить всю шапку таблицы
'Tab_1.HeaderRowRange(3).Select 'Выделить столбец№ в шапке таблице

'Tab_1.DataBodyRange.Select       'выделить всю таблицу
'Tab_1.DataBodyRange(3, 3).Select 'выделить ячейку
'Tab_1.DataBodyRange.Delete       'Удалить всю таблицу

'For a = 1 To x
'    Tab_1.ListColumns(a).Range.ColumnWidth = 20 'Задать ширину столбцов в 20
'Next a

'Tab_1.ShowTotals = False 'Включить строку итогов

a = Tab_1.ListColumns("Столбец1").Range.Column  'Определить № столбца по имени столбца
b = Tab_1.DataBodyRange(1, a)                   'Обратиться к ячейке (строка 1, столбец a)

MsgBox b
End Sub
Изменено: Kor - 4 Авг 2019 23:07:25 (орфографиеские ошибки)
Массовая замена данных в диапазоне (Массовый Ctrl F), Массовая замена данных в ячейках в диапазоне.
 
Здравствуйте, коллеги.
Жду замечаний по макросу!!!
Все вы использовали функцию найи и заменить (Ctrl F и / или Ctrl G). Однако, когда таких действий нужно выполнить много, то нужно немного заморочится и написать макрос, что я и зделал.
Как применить поиск и змену на всю книгу я не знаю =(

От Вас жду:
1) аамечания.
2) решения/подсказки о том. как сделать замену во всей книге

Заранее всех благодарю за посильную помощь!!!
Код
Option Explicit

Dim a As Variant 'Заменяемое значение
Dim b As Variant 'Заменимое значение
Dim c As Variant 'Переменная № строки в цикле заменяемого №1
Dim d As Variant 'Переменная № строки в цикле заменимого №2
Dim e As Variant 'Количество строк в выделенном диапазоне №1
Dim f As Variant 'Количество столбцов в выделенном диапазоне №1
Dim g As Variant 'Количество строк в выделенном диапазоне №2
Dim h As Variant 'Количество столбцов в выделенном диапазоне №2
Dim i As Variant 'Номер 1-ой строки в выделенном диапазоне №1
Dim j As Variant 'Номер 1-ой колонки в выделенном диапазоне №1
Dim k As Variant 'Номер 1-ой строки в выделенном диапазоне №2
Dim l As Variant 'Номер 1-ой колонки в выделенном диапазоне №2

Private Sub CommandButton1_Click()
    If RefEdit1 = "" Then 'Проверка диапазона №1 на заполнение
        MsgBox "нет данных в диапазоне №1"
        Exit Sub
    End If
    If RefEdit2 = "" Then 'Проверка диапазона №2 на заполнение
        MsgBox "нет данных в диапазоне №2"
        Exit Sub
    End If
'Выделеный диапазон №1
e = Range(RefEdit1).Rows.Count      'Количество строк в выделенном диапазоне №1
    
    If e < 1 Then 'Проверка диапазона №2 на заполнение
        MsgBox "мало строк в диапазоне №1"
        Exit Sub
    End If
    
f = Range(RefEdit1).Columns.Count   'Количество столбцов в выделенном диапазоне №1
i = Range(RefEdit1).Row             'Номер 1-ой строки в выделенном диапазоне №1
j = Range(RefEdit1).Column

'Выделеный диапазон №2
g = Range(RefEdit2).Rows.Count
'h = Range(RefEdit2).Columns.Count
k = Range(RefEdit2).Row
'l = Range(RefEdit2).Column

    If CheckBox1 = True Then
        Первый
        MsgBox "Первый"
    Else
        Второй
        MsgBox "Второй"
    End If
    
End Sub
Sub Второй()
    For c = i To (e + i - 1)
        a = Cells(c, j)
        b = Cells(c, j + 1)
        Range(RefEdit2).Replace What:=a, Replacement:=b, LookAt:=xlPart
    Next c
End Sub
Sub Первый()
    For c = i To (e + i - 1)
        a = Cells(c, j)
        b = Cells(c, j + 1)
        Range(RefEdit2).Replace What:=a, Replacement:=b, LookAt:=xlWhole
    Next c
End Sub
Калькулятор НДС в Excel
 
Создал формулу.
т.к. есть 5 варинтов НДС
0%
10%
16,67%
18% старый
20% новый
1 находит НДС от значения
2 находит НДС от значения и прибавляет его
3 находит НДС из значения
4 находит НДС из значения и вычитает его
Код
Function НДС(Значение As Long, Размер_НДС As Long, Действие As Integer)
    If Действие = 1 Then 'Найти размер НДС к значению
        НДС = Значение * (Размер_НДС / 100)
    End If
    If Действие = 2 Then 'Найти и прибавить размер НДС к значению
        НДС = Значение * (Размер_НДС / 100) + Значение
    End If
    If Действие = 3 Then 'Найти размер НДС от значения
        НДС = Значение / (100 + Размер_НДС) * Размер_НДС
    End If
    If Действие = 4 Then 'Найти и отнять размер НДС от значения
        НДС = Значение - Значение / (100 + Размер_НДС) * Размер_НДС
    End If
End Function
Изменено: Kor - 13 Янв 2019 13:05:31
Презентация. Оформления и макросы, Здесь выкладываются идеи по оформлению презентации.
 
Прошу Вас делиться идеями по оформлению презентаций.
Кто-то скажет не по теме, но проблема оформления презентаций для меня острая, надеюсь и вас это интересует.
UserForm для MAC. Выпадающие списки.
 
Pelena, замечательная статья. Благодарю Вас.
UserForm для MAC. Выпадающие списки.
 
vikttur,На маке работает корректно и все буквы нармальные, а вот еслии выслать обратно ...
UserForm для MAC. Выпадающие списки.
 
Кстати. Вот что получается когда рабочая книга xl (которая работает корректно) высылается на MAC отрывается, изменяется и отправляется обратно  
UserForm для MAC. Выпадающие списки.
 
Колеги нашел выход из положеня.
Обозвал нужный диапазон как "Diapazon"
Далее в саму форму ввода данных написал код:
Код
Private Sub UserForm_Initialize()

    Dim aCell As Range

    For Each aCell In Range("Diapazon") 'Вариант4
        ComboBox1.AddItem (aCell.Value)
    Next

End Sub
Это реально работает!!!
Остальные варианты еще не пробывал. Тестировать варианты проблематично =( MAC не мой
UserForm для MAC. Выпадающие списки.
 
Пишу простую форму ввода данных для MAC (в виндовс все работает).
Опишу свои ошибки и как часично их решил, а так же опишу возникшую проблему.

1) макрос писать только в отельном модуле. написать его в листе не вариант (у меня это была кнопка открытия макроса. перенес в отдельный модуль все зараработало).
2) выпадающие списки:
а) вариант первый - работает!!! Код располагается в форме ввода данных
Код
Private Sub UserForm_Activate()
    UserForm1.ComboBox1.AddItem "1 Бокс"
    UserForm1.ComboBox1.AddItem "2 Бокс"
    UserForm1.ComboBox1.AddItem "3 Бокс"
    UserForm1.ComboBox1.AddItem "4 Бокс"
    UserForm1.ComboBox1.AddItem "Ночная смена"
    UserForm1.ComboBox1.AddItem "Кафе"
End Sub
б) вариант второй - не работает. Код располагается в форме ввода данных
Выдает ошибку
"Ошибка выполнения 380"
не удалось установить свойство RowSource. Недопустимое значение свойства.
Код
Private Sub UserForm_Activate()
    UserForm1.ComboBox6.RowSource = "settings!O1:O8"
End Sub
в) вариант третий - не работает.
в свойстве ComboBox1
RowSource=settings!M1:M8 (ссылка на диапазон даных)

г) вариант четвертый- не работает.
в свойстве ComboBox1
RowSource =settings[settings] (ссылка на столбец из динамической таблицы)

Как задать диапазон ячеек (желательно динамической таблицы), чтобы список отражался в выпадающем списке?
Изменено: Kor - 16 Сен 2018 23:37:42
Применение макроса ко всем файлам в папке., Написал (спер и дописал) код VBA который помогает изменять формат файлв с xls на xlsx в выбранной папке.
 
Nordheim, Простите у Вас какая версия xl? возможнло возникают проблемы на этой почве?
хотя в коде не вижу формат сохранения xlsx
Изменено: Kor - 10 Сен 2018 14:47:32
Применение макроса ко всем файлам в папке., Написал (спер и дописал) код VBA который помогает изменять формат файлв с xls на xlsx в выбранной папке.
 
Проблема в том, что файлы, которые создаются не открываются
Изменено: Kor - 10 Сен 2018 14:39:55 (добавление комментариев)
Применение макроса ко всем файлам в папке., Написал (спер и дописал) код VBA который помогает изменять формат файлв с xls на xlsx в выбранной папке.
 
Nordheim, Простите. но Ваш код не работатет =( в таком виде.  
Применение макроса ко всем файлам в папке., Написал (спер и дописал) код VBA который помогает изменять формат файлв с xls на xlsx в выбранной папке.
 
Alec Perle, лишнюю часть (верхнее место для кода) удалил нафиг. Долго разбираля, как его убрать.
Написано, что чать кода спер у других на просторе интернета, а "t" - это таймер  
Применение макроса ко всем файлам в папке., Написал (спер и дописал) код VBA который помогает изменять формат файлв с xls на xlsx в выбранной папке.
 
Цитата
bedvit написал:
это как?

Удалить обозначенную часть и написать другой код или сослаться на другой макрос. Там подписи есть.
Вообще это все делается для чайников, вроде меня т.к. благодаря этим подписям в коде я двигаюсь в обучении.
Если получится, то я помогу кому-ниудь сделать подобную работу быстрее.
Изменено: Kor - 10 Сен 2018 00:40:37
Применение макроса ко всем файлам в папке., Написал (спер и дописал) код VBA который помогает изменять формат файлв с xls на xlsx в выбранной папке.
 

Данный код

1) Считает время работы макроса
2) Можно использовать с другими макросами
3) Именяет формат файла
P.S. если естьзамечания, то сразу же готов исправить, чтобы другим проще жить было.
Код
Sub Список_файлов()
   
    Dim t As Long                                                               'Задаем переменные
    Dim первый As FileDialog
    Dim второй As String
    
    t = Timer                                                                    'Зафиксировать время (для расчета времени работы макроса)
    MsgBox "Начинаем?"                                                           'Выводим преупреждение о начале работы макроса
    
    Set первый = Application.FileDialog(msoFileDialogFolderPicker)
        первый.Title = "Выбери папку"
        первый.AllowMultiSelect = False
        первый.Show
    
    второй = первый.SelectedItems(1)
    третий = Dir(второй & "\*.xls")

    Do While третий <> ""
    'Debug.Print третий
        'третий = Dir
        Set wb = Workbooks.Open(второй & "\" & третий)
        
        
'Ниже написан код который заменяет один формат на другой (записал макрорекордером не обессутьте и переделал под себя)

        Columns("G:G").Select                        'Это нужно для того чтобы активировать открытый в предыдущей части кода лист (чтобы код доработал именно здесь)
        ChDir ActiveWorkbook.Path                    'Как я понял это место сохранения готового файла
    ActiveWorkbook.SaveAs Filename:= _               '_-это перенос кода на другю строку
        ActiveWorkbook.Path & "\" & ActiveWorkbook.Name & "x", FileFormat:= _ ' определяет путь к папке, определяет имя файла
        xlOpenXMLWorkbook, CreateBackup:=False
        
        
        
 
        'Run "Макрос1"                                       'Какой макрос работает? это для тех случаев если работать должен макрос который написан отдельно
        wb.Close True: третий = Dir

    Loop
    
    MsgBox "Обработка данных продолжалась  " & Timer - t & " сек.", vbInformation 'засекает время работы макроса

End Sub
Изменено: Kor - 10 Сен 2018 00:37:45 (Удалил лишний эллемент (место для вставки кода))
Форма ввода данных. Отслеждивание входящих и исходящих писем.
 
Dima S,Alemox(комментарий ниже) Вы супер. ПОМОГЛО!!!!
Ігор Гончаренко, в гос учреждении идут официальные письма Outlook совсем не подходит.
Изменено: Kor - 27 Мар 2018 19:35:06
Форма ввода данных. Отслеждивание входящих и исходящих писем.
 
(офис 2016 лицензия 32х разрядная для дома и бизнеса)
Предистория.
Есть одна форма в которую операторы вводят входящие запросы. Все запросы записываются в книгу( База_Обращений)
Есть книга База_обращений с общим доступом на сервере которая находится в общем доступе совметного редактирования ("Общий доступ к книге" открыть). Стоит отметить, что открыть общий доступ смог перенеся этот документ сначала на свой личный компьютер, где есттественно офис не лицензионный и вернув его в сеть, т.к. лицензионый офис не дал возможность сделать файл общедоступным.

Проблема фильтрации данных в ListBox.
1) Я не могу фильтровать в уже отфильтрованном диапазоне.
2) Оказалась, что если свернуть форму и открыть форму вновь, то все данные в ListBox дублируются и форма увеличивается в 2 раза, если открыть 3 раза, то еще плюс 1 дубль исходных данных. Но на содержание данных это никак не влияет даже при сохранении.
N*M
где
N-количество исходных строк,
М - количество раз, которое свернули форму

Прошу Вас
1) писать комментарии по сути
2) предлагать идеи и говорить, как это сделать (надеюсь пригодиться другим)

Бонус.
Постарался описать все происходящие процессы и надеюсь этот файл будет хорошим рабочим примером для таких, как я новичков.

Заранее всем благодарен.
Изменено: Kor - 27 Мар 2018 21:13:23 (Изменился исходый файл (исправлены найденный ошибки))
Проверка правильности заполнения формы, Форма ввода данных и как проверить правильность ее заполнения
 
vikttur,Согласен. Грубоват я. =(
Михаил Лебедев,Прошу прощения за свой резкий коммпентарий написанный ранее
Проверка правильности заполнения формы, Форма ввода данных и как проверить правильность ее заполнения
 
Юрий, благодарю Вас за помощь. Лично мне уже не надо.
благодаря IsDate(TextBox1) и автоматическому заполнеиню ячейки при нажатии я решил проблему.
думаю людям это понадобится.
Сейчасведу разработку форму регистрации входящих писем. Позднее выложу. Думаю, что тем кто ищет полезную информацию всегда будет приятно получить помощь (надеюсь, что такая помощь не окажется медвежей).
Изменено: Kor - 3 Фев 2018 20:48:04
Проверка правильности заполнения формы, Форма ввода данных и как проверить правильность ее заполнения
 
Юрий, календарь использовать нет возможности в виду его отсутствия. по поводу перемещения благодаю. протестю.=)
Проверка правильности заполнения формы, Форма ввода данных и как проверить правильность ее заполнения
 
Код
    If IsDate(TextBox1) = False Then   'Этот опрератор проверяет является ли объект датой
        MsgBox "Это не дата"
        Exit Sub
    End If
Изменено: Kor - 2 Фев 2018 22:56:34
Проверка правильности заполнения формы, Форма ввода данных и как проверить правильность ее заполнения
 
Комментарии пользователей напоминают анекдот,
Ночь. пьяный мужик ползает под единственным фонарем на улице и что-то ищет. к нему подходит другой мужик и спрашивает:
- что ищешь?
- Да вот на бутылку деньги потерял.
- а где потерял?
-А вон у того забора
-А почему у фонаря ищешь?
- так здесь светлее

Так вот. Проблема вполне конкретная и мне про то что можно дописать что-то в выпадающем списке говорить не надо.Как сделать так чтобы при попытки сохранить данные 31,30 и когда нет 29 числа в месяце  появлялась предупреждение о попытки вбить неверную дату?[/SIZE][/CENTER][/FONT][/B]
Изменено: Kor - 2 Фев 2018 22:56:13
Проверка правильности заполнения формы, Форма ввода данных и как проверить правильность ее заполнения
 
Цитата
А ещё в выпадающем списке с месяцем можно написать что угодно
к чему это?
Проблема решена смотрите выше =)
Изменено: Kor - 13 Окт 2017 12:35:03
Проверка правильности заполнения формы, Форма ввода данных и как проверить правильность ее заполнения
 
TextBox
1) Следует помнить, что в TextBox ВСЕГДА текст. Там не может быть ни даты, ни чисел!!!
Проблема:
Проще говоря если вы сделаете модель
Код
 .Offset(TRows, 2).Value = TextBox1

где TextBox1 = "1"
то в в столбец вставится числа как "1",то в формате текста и произвести математические действия не получится.
Лечение:
1) самое простое (но не правильное) используя динамическую/умную таблицу в соседнем столбике прописать формулу =--A2
2) очень простое и правильное решение  .Offset(TRows, 2).Value =Val(TextBox2) для чисел
                                                                      .Offset(TRows, 3).Value = CDate(TextBox3) для дат


Изменено: Kor - 2 Фев 2018 23:00:27 (дополнения по функциям)
Страницы: 1 2 След.
Наверх