Новости:

Форум на данный момент в стадии обновления. Если у Вас возникли проблемы со входом в свою учетную запись - просьба писать на email: info@excel-vba.ru

Главное меню

Последние сообщения

#1
Цитата: Alexander.V от 13.05.2025, 08:50:08Прошу подсказать варианты решений
Ну вот как бы...Подсказать варианты или сделать все с нуля?  ;-D Т.к. подсказки все есть в предыдущих темах и по ссылке, которую Вы уже приложили.
Александр, Вы пробовали хотя бы записать макрорекордером действия во вставке значений и примечаний? Это возможно сделать без доп.помощи. При этом в теме, в которой Вы изначально разместили вопрос, я давал уже готовые строки кода по упрощению такой вставки(только значений, но с примечаниями тоже самое). Т.е. как бы не видно совсем, чтобы Вы хоть что-то уже сделали. А если сделали - что именно из найденного не получилось адаптировать по себя? Именно поэтому все и выглядит как "я тут что-то поискал, но сам делать не хочу - сделайте все за меня" :)
По сути все сводится к трем строкам кода:
'Selection.Copy 'где-то копируем какой-то диапазон
Sub PasteValuesAndComments()
    ActiveCell.PasteSpecial Paste:=xlPasteValues 'вставка значений
    ActiveCell.PasteSpecial Paste:=xlPasteComments 'вставка примечаний
End Sub
Добавить это в контекстное меню для ячеек можно так:
With Application.CommandBars("Cell").Controls.Add(before:=1)
    .Caption = "Вставить значения и примечания"
    .Style = 2
    .OnAction = "'" & ThisWorkbook.Name & "'!PasteValuesAndComments"
End With
Но здесь есть нюанс: пункт будет добавлен столько раз, сколько раз будет вызван этот код. Поэтому лучше сначала проверять наличие такого пункта в меню и удалять его, и только потом добавлять новый.

Ну а в сборе это все может выглядеть так:
'добавление в контекстное меню ячеек пункта вставки значений и примечаний
'этот код правильнее вызывать при открытии нужной книги - на событие Workbook_Open(хотя и здесь есть нюансы)
Sub AddButtonToCellMenu()
    Dim cbb
    Const sBCaption$ = "Вставить значения и примечания"
    'ищем пункт в меню и если он уже есть - удаляем, чтобы не было задвоений
    On Error Resume Next
    Set cbb = Application.CommandBars("Cell").Controls(sBCaption)
    If Not cbb Is Nothing Then
        cbb.Delete
    End If

    With Application.CommandBars("Cell").Controls.Add(before:=1)
        .Caption = sBCaption
        .Style = 2
        .OnAction = "'" & ThisWorkbook.Name & "'!PasteValuesAndComments"
    End With
End Sub
'
Sub PasteValuesAndComments()
    On Error GoTo Err_Handler
    ActiveCell.PasteSpecial Paste:=xlPasteValues 'вставка значений
    ActiveCell.PasteSpecial Paste:=xlPasteComments 'вставка примечаний
Err_Handler:
    If Err.Number = 1004 Then
        MsgBox "Буфер обмена пуст!", vbInformation, "https:\\excel-vba.ru"
    End If
End Sub

#2
Добрый день.
По работе приходится периодически копировать значения из одной таблицы в другую без формата и прочего, но с примечаниями,  в которых фиксируются изменения к ячейкам, делается это в два этапа: сначала вставляются только значения, потом через специальную вставку - примечания. Поэтому хочется эти операции оптимизировать. Копирование нужно производить при помощи клавиш или другим стандартным способом, а вставку - через контекстное меню через добавленную кнопку, как это сделано в этой статье.
Прошу подсказать варианты решений.
#3
Цитата: Alexander.V от 12.05.2025, 14:02:38У меня похожая задачка
Похожая, но другая.
Создайте новую тему.
И да: задача решается внимательным изучением этой темы, записью макроса вставки нужного и правки по образу и подобию кодов из этой темы.
А создание контекстного меню это вообще отдельная тема.
#4
Добрый день.
У меня похожая задачка:
Нужно при помощи макроса вставлять из скопированной ячейки только значение и примечание в выбранную ячейку. Вставку вызывать, к примеру, кнопкой из контекстного меню.
Как это реализовать?
#5
Вопросы по Excel и VBA / Re: Excel 2003 на Win10 каждый...
Последний ответ от McConst - 06.05.2025, 11:44:50
Проблема периодически возникает и всё время приходится её решать.
Поставил Windows 11. Здесь простой правкой реестра уже не обойтись. Windows 11 перестаёт открывать файлы через книгу или ярлык книги. Только через запуск приложения.

Долго мучал ИИ, прежде чем получил готовое решение. Приведу его здесь. Решение для Excel 2003

Создаём .reg файл для правки реестра:
Windows Registry Editor Version 5.00

[HKEY_CLASSES_ROOT\Excel.Sheet.8.Separate]
@="Microsoft Excel Worksheet (Separate Instance)"

[HKEY_CLASSES_ROOT\Excel.Sheet.8.Separate\shell]

[HKEY_CLASSES_ROOT\Excel.Sheet.8.Separate\shell\open]

[HKEY_CLASSES_ROOT\Excel.Sheet.8.Separate\shell\open\command]
@="\"C:\\Program Files (x86)\\Microsoft Office\\OFFICE11\\EXCEL.EXE\" /x \"%1\""

Кликаем на файл. В реестр добавятся новые ветки-клоны стандартной Excel.Sheet.8 (Excel 2003)
Запускаем cmd в режиме Администратора.
Выполняем
assoc .xls=Excel.Sheet.8.Separate
Тем самым меняем действия приложения Excel, ассоциированные с файлами .xls
Если нужно восстановить способ открытия Excel обратно, в cmd запускаем
assoc .xls=Excel.Sheet.8

У меня сработало.
#6
Всем привет, подскажите пожалуйста, как реализовать выборку данных с разных листов одной книги, через функции или же с помощью скрипта?
С учетом того, что структура столбцов в этих листах немного отличается (названия при этом одинаковые)
ссылка на файл: https://docs.google.com/spreadsheets/d/1uh4ILEiDXlX-n-iKr4Iho9wz9ujX-_TPR6B5kFWeacY/edit?gid=1718507152#gid=1718507152

#7
У меня значения в ячейках рассчитываются. Если напишите, что должно быть и почему текущий результат не верный - будет проще помочь. А так, я бы как минимум пару строк изменил (комментарии над ними проставил):
'dd - это даты. Значит объявлять надо тоже как даты, чтобы сравнение шло в итоге корректно
Function define_stat(ws As String, dd As Date, dta_rng As Range, pls_tank As String, pls_salt, option1 As String, def_ As String)
On Error Resume Next

Dim mass_(100) As Variant
Dim result As Double

j = -1

For Each r In dta_rng

pos = Split(r.Address, "$")
'у объекта Range есть свойства Row и Column, которые отвечают за номер строки и столбца.
'   поэтому их и надо ипользовать
If r.Row >= 3 Then

If r.Value = "" Then
 rng_fin = CStr(mass_(0)) & ":" & CStr(mass_(j))
 
 'Здесь можно задать дополнительные функции для вывода данных, например Average
 If def_ = "max" Then result_ = WorksheetFunction.Max(Sheets(ws).Range(rng_fin))
 If def_ = "aver" Then result_ = WorksheetFunction.average(Sheets(ws).Range(rng_fin))
 If def_ = "min" Then result_ = WorksheetFunction.Min(Sheets(ws).Range(rng_fin))
 
 
 'Debug.Print result_
 GoTo stp
End If

    a = Split(r.Value, " ")
    dd_now = CDate(a(0))
   
    If dd_now = dd Then
        'явно указываем поиск по значениям и по части ячейки (LookIn и lookat)
          w = Sheets(ws).Range(pls_tank & CInt(pos(2))).Find(option1, LookIn:=xlValues, lookat:=xlPart) 'признак резервуаров
             If w <> "" Then
              j = j + 1
              mass_(j) = Sheets(ws).Range(pls_salt & CInt(pos(2))).Address 'столбец, в котором находятся значения солей
              'Debug.Print mass_(j)
              'Debug.Print j
             End If
    End If
End If

Next

stp:
define_stat = result_ 'вывод результата функции

End Function
#8
Без примера данных разговор ни о чем. По сути, здесь все расписано уже: Как получить список уникальных(не повторяющихся) значений?
#9
Здравствуйте!
Есть задача выбрать уникальные значения из строки в Excel и вывести эти значения также в строку с любого указанного столбца, ячейки.
Допустим, данные (в моем случае это даты) находятся в строке A1:W1.
Результат требуется вывести в строку, начиная с ячейки AA1.
#10
Вопросы по Excel и VBA / Не могу понять почему неправил...
Последний ответ от MaMSo - 24.04.2025, 06:11:32
Добрый день, товарищи.
Столкнулся с проблемой, которую не могу решить своими силами.
Смысл функции: необходимо из реестра за определённую дату выбрать минимальное цифровое значение, которое соответствует определённым условиям.Вот формула

=define_stat("БУОС №4 КП-63";H5;'БУОС №4 КП-63'!B:B;"E";"F";"КДМНУ";"min")

Лист называется БУОС №4 КП-63;
В Н5 находится дата;
На листе БУОС №4 КП-63 в столбце В находятся даты;
В столбце Е находятся название типа "КП-63 ВтЛУ / КДМНУ" и "КП-63 ВтЛУ / РГС-3" (номера РГС меняются);
В столбце F находятся искомые данные в числовом виде
Нужно минимальное значение из 4-5 штук, которые находятся в столбце F. Данные нужно брать при условии, что в столбце Е будет "КП-63 ВтЛУ / КДМНУ".
В данный момент берёт минимальное значение за определённую дату из всех, находящихся в столбце F. И вот что интересно - в другой таблице работает правильно, хотя условия похожие.
В столбце В пустых ячеек нет. В другом месте эта формула работает правильно, но в том случае вместо слова "КДМНУ" стоит слово "нефть". В прилагаемом файле рабочее выделено зелёным цветом, а не рабочее желтым.
Это прямо загадка Вселенной - слово изменилось и формула работать перестала...
Любое изменение кода приводит к тому, что работать перестаёт. Вообще.
Яндекс.Метрика Рейтинг@Mail.ru