Этот код помогает создавать уникальные ключи во всех данных, но требует небольшого ручного управления.Буду рад конструктивной критике и дополнениям
Прикреплен файл с примером. Макрос срабатывает при открытии листа книги.
Код
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 - 06.08.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 - 04.08.2019 23:07:25(орфографиеские ошибки)
Здравствуйте, коллеги. Жду замечаний по макросу!!! Все вы использовали функцию найи и заменить (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
Прошу Вас делиться идеями по оформлению презентаций. Кто-то скажет не по теме, но проблема оформления презентаций для меня острая, надеюсь и вас это интересует.
Пишу простую форму ввода данных для 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] (ссылка на столбец из динамической таблицы)
Как задать диапазон ячеек (желательно динамической таблицы), чтобы список отражался в выпадающем списке?
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.09.2018 00:37:45(Удалил лишний эллемент (место для вставки кода))
(офис 2016 лицензия 32х разрядная для дома и бизнеса) Предистория. Есть одна форма в которую операторы вводят входящие запросы. Все запросы записываются в книгу( База_Обращений) Есть книга База_обращений с общим доступом на сервере которая находится в общем доступе совметного редактирования ("Общий доступ к книге" открыть). Стоит отметить, что открыть общий доступ смог перенеся этот документ сначала на свой личный компьютер, где есттественно офис не лицензионный и вернув его в сеть, т.к. лицензионый офис не дал возможность сделать файл общедоступным.
Проблема фильтрации данных в ListBox. 1) Я не могу фильтровать в уже отфильтрованном диапазоне. 2) Оказалась, что если свернуть форму и открыть форму вновь, то все данные в ListBox дублируются и форма увеличивается в 2 раза, если открыть 3 раза, то еще плюс 1 дубль исходных данных. Но на содержание данных это никак не влияет даже при сохранении.
N*M где
N-количество исходных строк, М - количество раз, которое свернули форму
Прошу Вас 1) писать комментарии по сути 2) предлагать идеи и говорить, как это сделать (надеюсь пригодиться другим)
Бонус. Постарался описать все происходящие процессы и надеюсь этот файл будет хорошим рабочим примером для таких, как я новичков.
Заранее всем благодарен.
Изменено: Kor - 27.03.2018 21:13:23(Изменился исходый файл (исправлены найденный ошибки))
Здравствуйте. В xl хоть и "бот". но небольшой код уже написал. Возникла проблема 31 февраля. Забить данную дату можно и xl ее успешно воспринимает и записывает. *Пример, 31 Февраль 12 = 12.02.1931 как победить не знаю =( Все бы ничего просто работать с этим будут бабульки и дуракоустойчивость должна быть высокая. В форме уже сделано так чтобы в определенных полях можно забивать Фамилия = только русский текст Имя = только русский текст Отчество = только русский текст День = только цифры от 0 до 9 Год = только цифры от 0 до 9 Добился того чтобы можно было переключаться TAB или Enter Потом буду доделывать форму дальше и если есть интерес опишу как что я сделал.
Сейчас прошу помощи в решении проблемы 31 февраля!!!!