Как сделать если ячейка A1 больше либо равно A2, то выполняется макрос - ячейка A2 закрашивается красным цветом?
» Excel VBA (часть 2)
caravan2007
проще это реализовать через условное форматирование: Формат/Условное форматирование
иначе, если пойти по пути макросов, нужно его будет привязывать к какому либо из событий листа, например, к изменению выделения, а это не очень грамотный путь. К примеру, можно получить подобную бяку
Код: Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("A1").Value >= Range("A2").Value Then
Range("A2").Interior.ColorIndex = 3
Else
Range("A2").Interior.ColorIndex = xlNone
End If
End Sub
проще это реализовать через условное форматирование: Формат/Условное форматирование
иначе, если пойти по пути макросов, нужно его будет привязывать к какому либо из событий листа, например, к изменению выделения, а это не очень грамотный путь. К примеру, можно получить подобную бяку
Код: Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("A1").Value >= Range("A2").Value Then
Range("A2").Interior.ColorIndex = 3
Else
Range("A2").Interior.ColorIndex = xlNone
End If
End Sub
оГРОМНОЕ спасибо!!!!
Имею список, который показывает фильтр по фамилии.
Чтоб создать кнопку, весь список скорпировать в новой лист?
Чтоб создать кнопку, весь список скорпировать в новой лист?
Вопрос по поводу Application.Run()
Как проверить, загружено ли дополнение, которое требуется для выражения:
a = Application.Run("ExcelLib1_Extension.API_Color_Code.ShowColor")
где ExcelLib1_Extension - имя проекта для AddIn'а.
Как проверить, загружено ли дополнение, которое требуется для выражения:
a = Application.Run("ExcelLib1_Extension.API_Color_Code.ShowColor")
где ExcelLib1_Extension - имя проекта для AddIn'а.
Добрый день.
Вопрос от начинающего, если можно.
Есть книга с данными об отработанных часах по каждому работнику по числам месяца. Надо создать другую книгу , в которую на основе данных из первой книги заносились бы данные по каждому работнику помесячно.
Надеюсь более или менее понятно обьяснил. Но в первой книге на каждом листе порядок следования рабочих может быть разный. Значит надо как то привязываться к табельному номеру работника и делать проверку.
Может кто нибудь мне помочь ? Скажите куда рыть, пожалуйста.
Вопрос от начинающего, если можно.
Есть книга с данными об отработанных часах по каждому работнику по числам месяца. Надо создать другую книгу , в которую на основе данных из первой книги заносились бы данные по каждому работнику помесячно.
Надеюсь более или менее понятно обьяснил. Но в первой книге на каждом листе порядок следования рабочих может быть разный. Значит надо как то привязываться к табельному номеру работника и делать проверку.
Может кто нибудь мне помочь ? Скажите куда рыть, пожалуйста.
По-моему это можно сделать только через Visual Basic, то есть тот, что встроен в Excell под кличкой "Макросы".
Если я вас правильно понял, то вам нужна сводная таблица на каждого.
Поскольку существует вероятность того, что имя и инициалы можно по-разному написать... (читать далее)
[more]Поскольку существует вероятность того, что имя и инициалы можно по-разному написать, то лучше проверять соответствие с табельным номером и учитывать "случайные пробелы" или их отсутствие, а ещё - сделать просто общую таблицу с табельными номерами и Ф.И.О. и проверять но ней.
Неплохо бы дату где-то на листе ставить, а не просто название месяца в имени закладки.
[/more]
Если я вас правильно понял, то вам нужна сводная таблица на каждого.
Поскольку существует вероятность того, что имя и инициалы можно по-разному написать... (читать далее)
[more]Поскольку существует вероятность того, что имя и инициалы можно по-разному написать, то лучше проверять соответствие с табельным номером и учитывать "случайные пробелы" или их отсутствие, а ещё - сделать просто общую таблицу с табельными номерами и Ф.И.О. и проверять но ней.
Неплохо бы дату где-то на листе ставить, а не просто название месяца в имени закладки.
[/more]
maxxsnake
Цитата:
А где пример того, что нужно получить?!!!
хоть словами опишите (или скриншот приложите). Потому что данные помесячно у Вас в конце каждого месяца уже считаются?..
Цитата:
Надо создать другую книгу , в которую на основе данных из первой книги заносились бы данные по каждому работнику помесячно.
А где пример того, что нужно получить?!!!
хоть словами опишите (или скриншот приложите). Потому что данные помесячно у Вас в конце каждого месяца уже считаются?..
В этом архиве два файла : 050_005.xls - исходный и Книга2.xls - какой должен получиться результирующий. Но в нем я сделал все жестко, то есть тупо жестко задал ссылки. А надо сделать так, чтобы проверялось по табельному номеру и потом выводились данные.
maxxsnake
Цитата:
тщательнее надо быть!!
Цитата:
В этом архиве два файлавы ссылочку дали старую... на Книга1.xls
тщательнее надо быть!!
SERGE_BLIZNUK
Дико извиняюсь, спешка. Ссылку исправил. Буду рад любой помощи.
Дико извиняюсь, спешка. Ссылку исправил. Буду рад любой помощи.
Сделал простенкий код экспорт из Excel в Access:
Код: Sub expaccess()
Selection.Copy
Dim dbs As Database
Dim aaa As TableDef
Dim rst As Recordset
Set dbs = OpenDatabase("C:\access-excel\db1.mdb")
Set aaa = dbs.CreateTableDef("А")
With aaa
.Fields.Append .CreateField("F", dbText)
.Fields.Append .CreateField("N", dbText)
.Fields.Append .CreateField("O", dbText)
.Fields.Append .CreateField("G", dbText)
.Fields.Append .CreateField("A", dbText)
.Fields.Append .CreateField("D", dbText)
.Fields.Append .CreateField("K", dbText)
.Fields.Append .CreateField("K1", dbText)
.Fields.Append .CreateField("K2", dbText)
.Fields.Append .CreateField("S", dbText)
.Fields.Append .CreateField("R", dbText)
.Fields.Append .CreateField("C", dbText)
.Fields.Append .CreateField("D1", dbText)
End With
dbs.TableDefs.Append aaa
dbs.Close
End Sub
Код: Sub expaccess()
Selection.Copy
Dim dbs As Database
Dim aaa As TableDef
Dim rst As Recordset
Set dbs = OpenDatabase("C:\access-excel\db1.mdb")
Set aaa = dbs.CreateTableDef("А")
With aaa
.Fields.Append .CreateField("F", dbText)
.Fields.Append .CreateField("N", dbText)
.Fields.Append .CreateField("O", dbText)
.Fields.Append .CreateField("G", dbText)
.Fields.Append .CreateField("A", dbText)
.Fields.Append .CreateField("D", dbText)
.Fields.Append .CreateField("K", dbText)
.Fields.Append .CreateField("K1", dbText)
.Fields.Append .CreateField("K2", dbText)
.Fields.Append .CreateField("S", dbText)
.Fields.Append .CreateField("R", dbText)
.Fields.Append .CreateField("C", dbText)
.Fields.Append .CreateField("D1", dbText)
End With
dbs.TableDefs.Append aaa
dbs.Close
End Sub
Подкажите плжалуйста как в Excel показывать Userform над определенной ячейкой таблицы?
robinLib
[more]Создай новый модуль
Код: Option Explicit
Sub MakeNumberFormatDisplay()
Dim TBar As CommandBar
Dim NewBtn As CommandBarButton
' Удаление существующей панели инструментов
On Error Resume Next
CommandBars("Числовой формат").Delete
On Error GoTo 0
' Создание панели инструментов
Set TBar = CommandBars.Add
With TBar
.Name = "Числовой формат"
.Visible = True
End With
' Добавление кнопок
Set NewBtn = CommandBars("Числовой формат").Controls.Add _
(Type:=msoControlButton)
With NewBtn
.Caption = ""
.OnAction = "ChangeNumFormat"
.TooltipText = "Щелкните для изменения числового формата"
.Style = msoButtonCaption
End With
Call UpdateToolbar
End Sub
Sub UpdateToolbar()
' Настройка подписи
On Error Resume Next
CommandBars("Числовой формат"). _
Controls(1).Caption = ActiveCell.NumberFormat
If Err <> 0 Then CommandBars("Числовой формат"). _
Controls(1).Caption = ""
End Sub
Sub ChangeNumFormat()
Application.Dialogs(xlDialogFormatNumber).Show
Call UpdateToolbar
End Sub
[more]Создай новый модуль
Код: Option Explicit
Sub MakeNumberFormatDisplay()
Dim TBar As CommandBar
Dim NewBtn As CommandBarButton
' Удаление существующей панели инструментов
On Error Resume Next
CommandBars("Числовой формат").Delete
On Error GoTo 0
' Создание панели инструментов
Set TBar = CommandBars.Add
With TBar
.Name = "Числовой формат"
.Visible = True
End With
' Добавление кнопок
Set NewBtn = CommandBars("Числовой формат").Controls.Add _
(Type:=msoControlButton)
With NewBtn
.Caption = ""
.OnAction = "ChangeNumFormat"
.TooltipText = "Щелкните для изменения числового формата"
.Style = msoButtonCaption
End With
Call UpdateToolbar
End Sub
Sub UpdateToolbar()
' Настройка подписи
On Error Resume Next
CommandBars("Числовой формат"). _
Controls(1).Caption = ActiveCell.NumberFormat
If Err <> 0 Then CommandBars("Числовой формат"). _
Controls(1).Caption = ""
End Sub
Sub ChangeNumFormat()
Application.Dialogs(xlDialogFormatNumber).Show
Call UpdateToolbar
End Sub
Привет всем.
Можно ли из VBA проверить подключенная к данной книге надстройка в References и если нет подключить ее, для того что бы можно было из этой книги вызывать напрямую процедуры находящие в надстройке ?
Можно ли из VBA проверить подключенная к данной книге надстройка в References и если нет подключить ее, для того что бы можно было из этой книги вызывать напрямую процедуры находящие в надстройке ?
Gavrik
Нельзя.
Нельзя.
Anton T
Просмотрел! Но ничего не походит. Опишу задачу еще раз:
Есть ячейка D3, прямо над этой ячейкой находится обьект прямоугольник (Rectangle) изображающий кнопку. При нажатии на эту кнопку в ее месте должна появиться форма отображающее дальнейший выбор пользователя - т.е. выглядеть это должно типа раскрывающегося меню. Для того чтобы это сделать нужно знать координаты этой кнопки (REctangle) или ячейки над которой она находится. Просто использовать Ceels().Top Cells().Left нельзя так как координаты при этом отсчитываются от ячейки A1 а не от верхнего левого угла экрана. Вопрос как найти при этом координаты left и top формы?
Просмотрел! Но ничего не походит. Опишу задачу еще раз:
Есть ячейка D3, прямо над этой ячейкой находится обьект прямоугольник (Rectangle) изображающий кнопку. При нажатии на эту кнопку в ее месте должна появиться форма отображающее дальнейший выбор пользователя - т.е. выглядеть это должно типа раскрывающегося меню. Для того чтобы это сделать нужно знать координаты этой кнопки (REctangle) или ячейки над которой она находится. Просто использовать Ceels().Top Cells().Left нельзя так как координаты при этом отсчитываются от ячейки A1 а не от верхнего левого угла экрана. Вопрос как найти при этом координаты left и top формы?
Запуталась совсем
Нужно сделать макрос который удаляет все дубликаты записей в строках.
Дано 2 файла из 1 раз в неделю добавляются данные в другой и они могут повториться при копировании.. серийный номер (должен быть уникальный).Записей около 500.. полазила по интернету нашла несколько вариантов - но всё не то..
Вот один из примеров - но он удаляет все записи которые были сделаны после первой - т.е это не то что мне нужно.
Sub DelDupRows()
Dim rngSrc As Range
Dim NumRows As Integer
Dim ThisRow As Integer
Dim ThatRow As Integer
Dim ThisCol As Integer
Dim RightCol As Integer
Dim J As Integer, K As Integer
Rows("2:1000").Select
Application.ScreenUpdating = False
Set rngSrc = ActiveSheet.Range(ActiveWindow.Selection.Address)
NumRows = rngSrc.Rows.Count
ThisRow = rngSrc.Row
ThatRow = ThisRow + NumRows - 1
ThisCol = rngSrc.Column
RightCol = ThisCol + rngSrc.Columns.Count - 1
'Start wiping out duplicates
For J = ThisRow To (ThatRow - 1)
If Cells(J, ThisCol) > "" Then
For K = (J + 1) To ThatRow
If Cells(J, ThisCol) = Cells(K, ThisCol) Then
Cells(K, ThisCol) = ""
End If
Next K
End If
Next J
'Remove rows with empty key cells
For J = ThatRow To ThisRow Step -1
If Cells(J, ThisCol) = "" Then
Range(Cells(J, ThisCol), _
Cells(J, RightCol)).Delete xlShiftUp
End If
Next J
Application.ScreenUpdating = True
End Sub
Я была бы очень благодарна если бы вы смогли мне помочь..
Нужно сделать макрос который удаляет все дубликаты записей в строках.
Дано 2 файла из 1 раз в неделю добавляются данные в другой и они могут повториться при копировании.. серийный номер (должен быть уникальный).Записей около 500.. полазила по интернету нашла несколько вариантов - но всё не то..
Вот один из примеров - но он удаляет все записи которые были сделаны после первой - т.е это не то что мне нужно.
Sub DelDupRows()
Dim rngSrc As Range
Dim NumRows As Integer
Dim ThisRow As Integer
Dim ThatRow As Integer
Dim ThisCol As Integer
Dim RightCol As Integer
Dim J As Integer, K As Integer
Rows("2:1000").Select
Application.ScreenUpdating = False
Set rngSrc = ActiveSheet.Range(ActiveWindow.Selection.Address)
NumRows = rngSrc.Rows.Count
ThisRow = rngSrc.Row
ThatRow = ThisRow + NumRows - 1
ThisCol = rngSrc.Column
RightCol = ThisCol + rngSrc.Columns.Count - 1
'Start wiping out duplicates
For J = ThisRow To (ThatRow - 1)
If Cells(J, ThisCol) > "" Then
For K = (J + 1) To ThatRow
If Cells(J, ThisCol) = Cells(K, ThisCol) Then
Cells(K, ThisCol) = ""
End If
Next K
End If
Next J
'Remove rows with empty key cells
For J = ThatRow To ThisRow Step -1
If Cells(J, ThisCol) = "" Then
Range(Cells(J, ThisCol), _
Cells(J, RightCol)).Delete xlShiftUp
End If
Next J
Application.ScreenUpdating = True
End Sub
Я была бы очень благодарна если бы вы смогли мне помочь..
MORB_id
Ошибаешься
Gavrik
Подключаешь Tools/References
Microsoft Visual Basic for Application Extensibility и через коллекцию
ActiveWorkbook.VBProject.References (или ThisWorkbook...) используешь необходимое, включая и подключение по файлу или GUID
Ошибаешься
Gavrik
Подключаешь Tools/References
Microsoft Visual Basic for Application Extensibility и через коллекцию
ActiveWorkbook.VBProject.References (или ThisWorkbook...) используешь необходимое, включая и подключение по файлу или GUID
AndVGri
Спасибо, щас попробую
Спасибо, щас попробую
anjaa
Цитата:
сделайте маленькие файлы с примером... и выложите (rapidshare zalil.ru mytempdir.com ifolder.ru и т.д....)
А код, который Вы привели - очень похож на заточенный под какую-то определённую задачу..
Цитата:
Нужно сделать макрос который удаляет все дубликаты записей в строках.
Дано 2 файла из 1 раз в неделю добавляются данные в другой и они могут повториться при копировании.. серийный номер (должен быть уникальный).
сделайте маленькие файлы с примером... и выложите (rapidshare zalil.ru mytempdir.com ifolder.ru и т.д....)
А код, который Вы привели - очень похож на заточенный под какую-то определённую задачу..
robinLib
Цитата:
Может сделать через GetWindowRect и FindWindow?
[more=Описание]
Код:
Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Отыскивает координаты окна.
Параметры:
lpRect - Переменная типа Rect которой будут присвоены координаты.
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Возвращает нуль если произошла ошибка и ненуль в противном случае.
Цитата:
[...] Просто использовать Ceels().Top Cells().Left нельзя так как координаты при этом отсчитываются от ячейки A1 а не от верхнего левого угла экрана. Вопрос как найти при этом координаты left и top формы?
Может сделать через GetWindowRect и FindWindow?
[more=Описание]
Код:
Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Отыскивает координаты окна.
Параметры:
lpRect - Переменная типа Rect которой будут присвоены координаты.
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Возвращает нуль если произошла ошибка и ненуль в противном случае.
Всем привет!
Ребята подскажите что неправильно написал.
Надо поставить пароль на вторую форму.Помогите чайнику!!! Учусь
Dim s As String
Sub Поле6_Щелкнуть()
UserForm1.Show
End Sub
Private Sub CommandButton1_Click()
s = "1"
If s = "" Then
UserForm2.Show 'показать новую форму
Unload Me 'спрятать родительскую форму - Макс
Else
MsgBox "Неправильный пароль"
End If
End
End Sub
Ребята подскажите что неправильно написал.
Надо поставить пароль на вторую форму.Помогите чайнику!!! Учусь
Dim s As String
Sub Поле6_Щелкнуть()
UserForm1.Show
End Sub
Private Sub CommandButton1_Click()
s = "1"
If s = "" Then
UserForm2.Show 'показать новую форму
Unload Me 'спрятать родительскую форму - Макс
Else
MsgBox "Неправильный пароль"
End If
End
End Sub
chalvs
Пример в виде XLS-файла можно?
Пример в виде XLS-файла можно?
Блогодорю nick7inc за помощ
если можно подскажи
если можно подскажи
chalvs
Цитата:
nick7inc предложил Вам выложить пример вашего Excel файла с вашими кнопками и формой в Сеть (на любой беспланый файлхостинг: rapidshare.com iFolder.ru zalil.ru mytempdir.com и т.д.) возмите Ваш файлик, запакуйте его в архив, зайдите на любой из упомянутых сайтов и укажите его. Потом Upload (выгрузить).
а по существу вопроса - я, к сожалению, абсолютный профан в использовании форм в Excel, но!! меня удивляют вот эти строчки:
Код:
s = "1"
If s = "" Then
Цитата:
если можно подскажи
nick7inc предложил Вам выложить пример вашего Excel файла с вашими кнопками и формой в Сеть (на любой беспланый файлхостинг: rapidshare.com iFolder.ru zalil.ru mytempdir.com и т.д.) возмите Ваш файлик, запакуйте его в архив, зайдите на любой из упомянутых сайтов и укажите его. Потом Upload (выгрузить).
а по существу вопроса - я, к сожалению, абсолютный профан в использовании форм в Excel, но!! меня удивляют вот эти строчки:
Код:
s = "1"
If s = "" Then
chalvs
Цитата:
Насколько я понял s="1" это nароль. Его надо куда-то вводить, например, в TextBox. Тогда
Код: Private Sub CommandButton1_Click()
Dim s As Integer
s = TextBox1.Text
If s = 1 Then
Unload Me
UserForm2.Show
Else
MsgBox "Неправильный пароль"
End If
End Sub
Цитата:
Dim s As String
Sub Поле6_Щелкнуть()
UserForm1.Show
End Sub
Private Sub CommandButton1_Click()
s = "1"
If s = "" Then
UserForm2.Show 'показать новую форму
Unload Me 'спрятать родительскую форму - Макс
Else
MsgBox "Неправильный пароль"
End If
End
End Sub
Насколько я понял s="1" это nароль. Его надо куда-то вводить, например, в TextBox. Тогда
Код: Private Sub CommandButton1_Click()
Dim s As Integer
s = TextBox1.Text
If s = 1 Then
Unload Me
UserForm2.Show
Else
MsgBox "Неправильный пароль"
End If
End Sub
Всем привет!!!
Подскажите если не трудно.
Вопрос по MsgBox
Написал текст для MsgBox, текст длинный. Когда выходит MsgBox
,то отображается только часть текста. Как увеличить количество знаков для MsgBox?
Спасибо
Подскажите если не трудно.
Вопрос по MsgBox
Написал текст для MsgBox, текст длинный. Когда выходит MsgBox
,то отображается только часть текста. Как увеличить количество знаков для MsgBox?
Спасибо
GFSGF
Мне не совсем ясно, что именно у вас произошло. На сколько длинный текст? Или у окна ширины не хватает? Если последнее, то надо вставлять символы перевода строки:
Код:
msgbox "Трям-пам-пам-пам-пам-пам-пам-пам-пам-пам"+chr$(13)+ _
"Трям-пам-пам-пам-пам-пам-пам-пам-пам-пам"
Мне не совсем ясно, что именно у вас произошло. На сколько длинный текст? Или у окна ширины не хватает? Если последнее, то надо вставлять символы перевода строки:
Код:
msgbox "Трям-пам-пам-пам-пам-пам-пам-пам-пам-пам"+chr$(13)+ _
"Трям-пам-пам-пам-пам-пам-пам-пам-пам-пам"
Подскажите плиз: как из столбца выбрать все уникальные значения и записать их на отдельный лист, виде коротго столбца с этими уникальными значениями?
Страницы: 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133
Предыдущая тема: Написание своего HyperTerminal для считывания данных
Форум Ru-Board.club — поднят 15-09-2016 числа. Цель - сохранить наследие старого Ru-Board, истории становления российского интернета. Сделано для людей.