Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Несколько макросов на одном листе - как объединить?
 
#1
23.02.2018 16:18:51
Добрый день.
подскажите, пожалуйста, как вставить несколько макросов на один и тот же лист?

например, у меня есть уже макрос на листе, просто вставляя ниже еще один, ничего не работает.
Я не разбираюсь в макросах, но очень надо, чтобы работало.

спасибо  
Изменено: jelena_al - 23.02.2018 16:34:33
 
 
 
#2
23.02.2018 16:21:44
Скорее всего макросы событийные. Объедините их в один
Согласие есть продукт при полном непротивлении сторон
 
 
 
#3
23.02.2018 16:22:20
1. Прочитать и выполнить правила этого форума.
2. а там посмотрим...
 
 
 
#4
23.02.2018 16:40:26
Лично я файл с макросами смогу посмотреть только вечером, но тут полно народу...
 
 
 
#5
23.02.2018 16:44:32
Мне главное, чтобы хоть кто-то помог, поскольку я вообще в этом не понимаю ничего.
 
 
 
#6
23.02.2018 16:46:16
Если выложите коды текстом - могу посмотреть.
Ну или подождите что скажет Sanja
 
 
 
#7
23.02.2018 16:47:30
Что должно быть результатом работы объединенного макроса? В чем ИХ задача? Просто, по-русски, обычными словами
Согласие есть продукт при полном непротивлении сторон
 
 
 
#8
23.02.2018 16:49:47
Цитата
Hugo написал: выложите коды текстом
Копировал из файла в русской раскладке, в файле так-же :)
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    For Each cell In Target   'ejam pa visвm izmainоtвm рыnвm
       If Not Intersect(cell, Range("b2:b50000")) Is Nothing Then  'ja mainоta рыna ietilpst diapazonв b2:b100
            With cell.Offset(0, 1)         'ievadam blakus pa labi рыnв datumu
               .Value = Now
               .EntireColumn.AutoFit  '????????? ?????????? ?????? ??? ??????? c, ????? ???? ????????? ? ??????
            End With
       End If
    Next cell
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewCellValue$, OldComment$
Dim cell As Range
     
    '???? ?????? ?? ? ????????????? ?????????, ?? ???????
    If Intersect(Target, Range("B2:B50000")) Is Nothing Then Exit Sub
       
    '?????????? ??? ?????? ? ?????????? ???????
    For Each cell In Intersect(Target, Range("B3:B5"))
        If IsEmpty(cell) Then
            NewCellValue = "?????? ???????" '????????? ??????? ??????
        Else
            NewCellValue = cell.Formula     '??? ?? ??????????
        End If
        On Error Resume Next
         
        With cell
            OldComment = .Comment.Text & Chr(10)
            .Comment.Delete     '??????? ?????? ?????????? (???? ????)
            .AddComment         '????????? ????? ? ?????? ? ???? ?????
            .Comment.Text Text:=OldComment & Application.UserName & " " & _
                            Format(Now, "MM.DD.YY h:MM:ss") & " : " & NewCellValue
            .Comment.Shape.TextFrame.AutoSize = True    '?????? ?????????? ???????
            .Comment.Shape.TextFrame.Characters.Font.Size = 8
        End With
    Next cell
End Sub
Согласие есть продукт при полном непротивлении сторон
 
 
 
#9
23.02.2018 16:52:15
идея такая, есть 2 разных макроса, которые просто должны работать на одном листе и каждый выполнять свою функцию. Оба макроса взяты с planeta-excel.
1-ый макрос должен ставить дату, когда что-то меняется в ячейке В, второй должен фиксировать изменения в комментариях.

вот ссылки на оба макроса.
https://www.planetaexcel.ru/techniques/6/44/
https://www.planetaexcel.ru/techniques/5/208/
по отдельности оба макроса работают
 
 
 
#10
23.02.2018 17:04:46
Файл не смотрел, но попробуйте оба заменить на один такой:
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewCellValue$, OldComment$
Dim cell As Range
      
    '???? ?????? ?? ? ????????????? ?????????, ?? ???????
    If Intersect(Target, Range("B2:B50000")) Is Nothing Then Exit Sub
        
     Application.EnableEvents = False
     
        For Each cell In Target   'ejam pa visвm izmainоtвm рыnвm
       If Not Intersect(cell, Range("b2:b50000")) Is Nothing Then  'ja mainоta рыna ietilpst diapazonв b2:b100
            With cell.Offset(0, 1)         'ievadam blakus pa labi рыnв datumu
               .Value = Now
               .EntireColumn.AutoFit  '????????? ?????????? ?????? ??? ??????? c, ????? ???? ????????? ? ??????
            End With
       End If
    Next cell
    
    '?????????? ??? ?????? ? ?????????? ???????
    For Each cell In Intersect(Target, Range("B3:B5"))
        If IsEmpty(cell) Then
            NewCellValue = "?????? ???????" '????????? ??????? ??????
        Else
            NewCellValue = cell.Formula     '??? ?? ??????????
        End If
        On Error Resume Next
          
        With cell
            OldComment = .Comment.Text & Chr(10)
            .Comment.Delete     '??????? ?????? ?????????? (???? ????)
            .AddComment         '????????? ????? ? ?????? ? ???? ?????
            .Comment.Text Text:=OldComment & Application.UserName & " " & _
                            Format(Now, "MM.DD.YY h:MM:ss") & " : " & NewCellValue
            .Comment.Shape.TextFrame.AutoSize = True    '?????? ?????????? ???????
            .Comment.Shape.TextFrame.Characters.Font.Size = 8
        End With
    Next cell
    
    Application.EnableEvents = True
    
End Sub


Ну а тут вероятно нужно что-то изменить:
Код
NewCellValue = "?????? ???????"
 
 
 
#11
23.02.2018 17:12:42
У Вас еще и защита листа есть. Какой пароль?
Согласие есть продукт при полном непротивлении сторон
 
 
 
#12
23.02.2018 17:14:40
пароль 123
 
 
 
#13
23.02.2018 17:14:56
Hugo, вставила макрос, пишет ошибку run time error 424

пароль 123
 
 
 
#14
23.02.2018 17:27:45
Замените два Ваших на этот
Код
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("B2:B10000")) Is Nothing Then  'если изменененная ячейка попадает в диапазон A2:A100
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Me.Unprotect "123"
    With Target
        NewCellValue = IIf(IsEmpty(.Value), "Ячейка очищена", .Formula)
        If Not .Comment Is Nothing Then
            OldComment = .Comment.Text & Chr(10)
            .Comment.Delete     'удаляем старое примечание (если было)
        End If
        .AddComment         'добавляем новое и вводим в него текст
        With .Comment
            .Text Text:=OldComment & Application.UserName & " " & Format(Now, "MM.DD.YY h:MM:ss") & " : " & NewCellValue
            With .Shape.TextFrame
                .AutoSize = True    'делаем автоподбор размера
                .Characters.Font.Size = 8
            End With
        End With
        .Offset(0, 1).Value = Now       'вводим в соседнюю справа ячейку дату
    End With
End If
Me.Protect "123"
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Согласие есть продукт при полном непротивлении сторон
 
 
 
#15
23.02.2018 17:30:01
Там скорее всего кириллица в коде вообще не читается, т.к. вижу диакритика латышская была. Ну это ерунда, можно комменты транслитом писать, ну или переведите.
 
 
 
#16
23.02.2018 17:35:23
Sanja, ой, как здорово! работает! Спасибо огромное!
извините, за глупые вопросы
получается надо переписывать макросы или есть какая то система?
Просто у меня еще есть макросы, которые надо объеденить, но только уже они на всю книгу относятся.  
 
 
 
#17
23.02.2018 17:38:27
Цитата
jelena_al написал: получается надо переписывать макросы или есть какая то система?
Событийные макросы, простым копированием/добавлением, редко удается подружить
Изменено: Sanja - 23.02.2018 17:40:02
Согласие есть продукт при полном непротивлении сторон
 
 
 
#18
23.02.2018 17:47:13
Два отдельных макроса на одно событие жить вместе не могут! Что логично.
 
 
 
#19
23.02.2018 20:47:21
Проверил в файле - да и мой макрос нормально работает, только нужно снять защиту и с третьего столбца, ну и диапазоны привести в соответствие. Иначе когда нет пересечения изменённой ячейки с указанным диапазоном - то и перебирать нечего, потому и ошибка. Если исправить - даты и комментарии исправно пишет.
 
 
 
#20
23.02.2018 21:54:56
понятно, спасибо большое.

Скажите, может можно попросить еще настроить макрос

суть такая же, только  надо, чтобы работал на всю книгу.
1.запрет печати книги
2. чтобы в листе лог отображались вход и выход каждого пользователя (их 6)
3. чтобы каждый пользователь видел только лист со своим имнем (имена в листах книги)

Буду очень благодрна, если сможете помочь.

https://www.planetaexcel.ru/techniques/5/233/
https://www.planetaexcel.ru/techniques/5/196/
https://www.planetaexcel.ru/techniques/5/177/
 
 
 
#21
23.02.2018 23:05:14
Не в этой теме. Ознакомьтесь, пожалуйста, с правилами форума
 
 
 
Страницы: 1
Наверх