Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Равенство ячеек на разных листах при заполнении одной из них
 
#1
16.11.2017 16:17:33
Здравствуйте! Поиск не помог. Собственно, даже не знаю какую формулировку забить.
Помогите пожалуйста решить вроде бы простую задачку. Формулами не получается, создаются циклические ссылки.
Простой пример. В книге 3 листа: Лист1, Лист2, Лист3.
Задача: При заполнении ячейки А1 на любом из листов, в других листах тоже бы отобразились эти данные в ячейке А1. Изначально, ячейки пустые.
 
 
 
#2
16.11.2017 16:27:23
maxrus163, встаёте на ячейку A1, выделяете остальные листы с помощью Shift, Ctrl и левой кнопки мыши (или ПКМ, Выделить все листы). Вводите значение.
Дальше правой кнопкой мыши на ярлыке листа - Разгруппировать листы.
 
 
 
#3
16.11.2017 16:33:59
Это простой пример. В оригинальном файле листов значительно больше и ячейки находятся по разным адресам. Я его не выкладываю, так как долго объяснять, что мне нужно. Это не подходит. Так бы я и не спрашивал.
 
 
 
#4
17.11.2017 07:42:23
На другом форуме, мне сказали, что без макроса не обойтись. А макросы я могу создавать только через разработчик Экселя. Писать не могу.
И написали макрос, который работает только на одном листе.
Код
Private Sub Worksheet_Change(ByVal Target As Range)
     Dim d_ As Range, d0_ As Range
     Set d0_ = Range("A1:A20,C2")
     Set d_ = Intersect(Target, d0_)
     If Not d_ Is Nothing Then
         Application.EnableEvents = 0
         d0_ = d_(1).Value
         Application.EnableEvents = 1
     End If
 End Sub

Может найдутся умельцы скорректировать его для работы с ячейками на разных листах. Буду благодарен.
Пример файла с этим макросом прилагаю.
 
 
 
#5
17.11.2017 08:28:37
В модуль книги поместите код:
Код
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim ws As Worksheet
    If Target.Count > 1 Then Exit Sub
    If Intersect(Target, [A1,B2,C3]) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    For Each ws In Sheets: ws.Range(Target.Address) = Target.Value: Next
    Application.EnableEvents = True
End Sub
Изменение значения в ячейках "A1", "B2" и "C3" приведет к изменению значений по этим адресам во всех листах книги.
Чем шире угол зрения, тем он тупее.
 
 
 
#6
17.11.2017 09:05:27
SAS888, да, по этим ячейкам все работает. Спасибо! Я так понимаю, что если данный макрос внедрить в другую книгу, указать нужные адреса ячеек, то они буду работать на всех листах, что есть в книге. Как бы получается сквозное дублирование. Я вот задумался,а если например, в Листе1 это ячейка A1, в Листе2 - ячейка В2, в Листе3 - ячейка С3. То есть при введении цифры например 25 на листе1 ячейка A1? она должна отобразиться на Листе2 в ячейке В2 и Листе3 ячейкеС3. То есть как мне указать в макросе конкретный лист и ячейку, где мне это надо?
Изменено: maxrus163 - 17.11.2017 09:05:50
 
 
 
#7
17.11.2017 10:43:01
Например, для 3-х листов:
Код
Option Base 1
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim i As Integer, a()
    a = Array("$A$1", "$B$2", "$C$3") 'ячейки на 1-ом, 2-ом и 3-ем листе соответственно
    If Target.Count > 1 Then Exit Sub
    If Target.Address <> a(Sh.Index) Then Exit Sub
    Application.EnableEvents = False
    For i = 1 To 3: Sheets(i).Range(a(i)) = Target.Value: Next
    Application.EnableEvents = True
End Sub
В примере зависимые ячейки :
На 1-ом листе - "A1"
На 2-ом листе - "B2"
На 3-ем листе - "C3"
Изменение значения любой из этих ячеек изменит все эти ячейки. Пример во вложении.
Изменено: SAS888 - 17.11.2017 10:45:02
Чем шире угол зрения, тем он тупее.
 
 
 
#8
17.11.2017 11:43:44
SAS888,спасибо, впечатляет) можно пояснить еще? как макрос понимает, что зависимая ячейка "$B$2" именно на Листе2, а не на другом. Я думал в макросе будет явно прописано названия листа, но я не вижу или просто не понимаю. Извиняюсь, за назойливость! В программировании не разбираюсь(
 
 
 
#9
20.11.2017 05:06:09
В предлагаемом примере привязка не к имени листа, а к его порядковому номеру (Sh.Index).
Соответственно, в массиве, содержащем адреса ячеек, значение 1-го элемента относится к 1-му листу и т. д.
Чем шире угол зрения, тем он тупее.
 
 
 
#10
20.11.2017 13:17:33
SAS888, спасибо! - единственному откликнувшемуся! Буду применять ваш макрос.
 
 
 
#11
20.11.2017 14:44:32
SAS888,  связал я, значит, первую группу ячеек вашим макросом. Функционирует!
Код
Option Base 1
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim i As Integer, a()

    a = Array("$AA$1", "$AT$1", "$T$1", "$T$1", "$T$1", "$T$1", "$T$1", 
"$M$3", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", 
"$X$4", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", 
"$X$4")
    If Target.Count > 1 Then Exit Sub
    If Target.Address <> a(Sh.Index) Then Exit Sub
    Application.EnableEvents = False
    For i = 1 To 26: Sheets(i).Range(a(i)) = Target.Value: Next
    Application.EnableEvents = True
End Sub

Далее, я бы хотел, связать еще одну группу ячеек на этих листах, например вот этой строчкой
a = Array("$AA$2", "$AT$2", "$T$2", "$T$2", "$T$2", "$T$2", "$T$2", "$N$3", "$Y$4", "$Y$4", "$Y$4", "$Y$4", "$Y$4", "$Y$4", "$Y$4", "$Y$4", "$Y$4", "$Y$4", "$Y$4", "$Y$4", "$Y$4", "$Y$4", "$Y$4", "$Y$4", "$Y$4", "$Y$4")

А не получается. Как правильно это сделать? Нужен второй макрос или нужно правильно написать все в одном?
Изменено: maxrus163 - 20.11.2017 14:50:56
 
 
 
#12
20.11.2017 15:12:28
Вариант. Для двух диапазонов
Код
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, Union([$AA$1], [$AA$2], [$AT$1], [$AT$2], [$T$1], [$T$2], [$M$3], [$N$3], [$X$4], [$Y$4])) Is Nothing Then
    Dim i&, j&
    Select Case Target.Address
        Case "$AA$1", "$AA$2"
            i = 1: j = 1
        Case "$AT$1", "$AT$2"
            i = 2: j = 2
        Case "$T$1", "$T$2"
            i = 3: j = 7
        Case "$M$3", "$N$3"
            i = 8: j = 8
        Case "$X$4", "$Y$4"
            i = 9: j = 26
    End Select
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    For i = i To j
        Worksheets(i).Range(Target.Address) = Target.Value
    Next
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Согласие есть продукт при полном непротивлении сторон
 
 
 
#13
20.11.2017 15:28:10
Sanja,работает только на ячейках "X", "Y". На других не работает. Я заметил, что макрос по другому написан. Как это все сложно для меня (
Хотелось бы вариант SAS888 доработать. И главное, мне еще нужно понять принцип добавления новых диапазонов, потомучто их больше чем 2. Каждый раз не могу же форумчан просить. Пошлют куда подальше.
Изменено: maxrus163 - 20.11.2017 15:31:00
 
 
 
#14
21.11.2017 05:11:24
Можно так (для 3-х диапазонов на 3-х листах):
Код
Option Base 1

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim a1(), a2(), a3()
    If Target.Count > 1 Then Exit Sub
    a1 = Array("$A$1", "$B$1", "$C$1") '1-я группа ячеек на 1-ом, 2-ом и 3-ем листе соответственно
    a2 = Array("$A$2", "$B$2", "$C$2") '2-я группа ячеек на 1-ом, 2-ом и 3-ем листе соответственно
    a3 = Array("$A$3", "$B$3", "$C$3") '3-я группа ячеек на 1-ом, 2-ом и 3-ем листе соответственно
    Select Case Target.Address
        Case a1(Sh.Index): FillCells a1, Target.Value
        Case a2(Sh.Index): FillCells a2, Target.Value
        Case a3(Sh.Index): FillCells a3, Target.Value
    End Select
End Sub

Sub FillCells(arr, iVal)
    Dim i As Integer
    Application.EnableEvents = False
    For i = 1 To UBound(arr): Sheets(i).Range(arr(i)) = iVal: Next
    Application.EnableEvents = True
End Sub
Думаю, что в данную конструкцию Вы самостоятельно сможете добавлять массивы адресов ячеек по листам. Важно, чтобы порядок адресов в массивах соответствовал соответствующему листу и количество элементов массивов равнялось количеству листов.
Если требуется связать ячейки не на всех листах, то можно в соответствующем массиве элементу соответствующего листа присвоить не адрес, а просто какой-нибудь символ (например, "x"), а в процедуре "FillCells" добавить условие:
Код
Sub FillCells(arr, iVal)
    Dim i As Integer
    Application.EnableEvents = False
    For i = 1 To UBound(arr)
        If arr(i) <> "x" Then Sheets(i).Range(arr(i)) = iVal
    Next
    Application.EnableEvents = True
End Sub
Так, например, если в основной процедуре написать a1 = Array("$A$1", "x", "$C$1"), то будут связаны ячейки "A1" 1-го листа и "C1" 3-го листа. На 2-ом листе никаких изменений не будет.
Пример во вложении.
Изменено: SAS888 - 21.11.2017 06:05:46
Чем шире угол зрения, тем он тупее.
 
 
 
#15
21.11.2017 07:45:31
SAS888, в очередной раз, спасибо за подробный мануал. Буду внедрять, отпишусь по результатам.
 
 
 
#16
21.11.2017 09:04:47
Пока создал 4 диапазона из 20, использовал пропуски листов. Все работает! ) Очень рад!
Единственное, что заметил, в вашем примере при нажатии на "Delete" на ячейке, то в других тоже все удаляется. То есть, так и должно быть.
А у меня почему то удаляется только в этой ячейке, в других синхронизированных не удаляется. В принципе не критично, я ставлю ноль и ячейки очищаются.
 
 
 
#17
21.11.2017 13:47:47
SAS888, на пятом диапазоне возникла ошибка "Subscript out of range", когда я ввожу значения в ячейках "Х4". Когда ввожу значение в ячейку "М25" ячейки "X4" нормально заполняются. Диапазоны а1-а4 работают исправно. Что не так сделал?
Вот код
Код
Option Base 1

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim a1(), a2(), a3(), a4(), a5()
    If Target.Count > 1 Then Exit Sub
    a1 = Array("x", "x", "x", "x", "x", "x", "x", "$M$3", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4")
    a2 = Array("x", "x", "x", "x", "x", "x", "x", "$N$3", "$Y$4", "$Y$4", "$Y$4", "$Y$4", "$Y$4", "$Y$4", "$Y$4", "$Y$4", "$Y$4", "$Y$4", "$Y$4", "$Y$4", "$Y$4", "$Y$4", "$Y$4", "$Y$4", "$Y$4", "$Y$4")
    a3 = Array("x", "x", "x", "x", "x", "x", "x", "$O$3", "$Z$4", "$Z$4", "$Z$4", "$Z$4", "$Z$4", "$Z$4", "$Z$4", "$Z$4", "$Z$4", "$Z$4", "$Z$4", "$Z$4", "$Z$4", "$Z$4", "$Z$4", "$Z$4", "$Z$4", "$Z$4")
    a4 = Array("x", "x", "x", "x", "x", "x", "x", "$P$3", "$AA$4", "$AA$4", "$AA$4", "$AA$4", "$AA$4", "$AA$4", "$AA$4", "$AA$4", "$AA$4", "$AA$4", "$AA$4", "$AA$4", "$AA$4", "$AA$4", "$AA$4", "$AA$4", "$AA$4", "$AA$4")
    a5 = Array("x", "x", "x", "x", "x", "x", "x", "$M$25", "x", "x", "x", "x", "x", "x", "x", "x", "x", "x", "x", "x", "x", "x", "x", "x", "x", "x", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4", "$X$4")
      Select Case Target.Address
        Case a1(Sh.Index): FillCells a1, Target.Value
        Case a2(Sh.Index): FillCells a2, Target.Value
        Case a3(Sh.Index): FillCells a3, Target.Value
        Case a4(Sh.Index): FillCells a4, Target.Value
        Case a5(Sh.Index): FillCells a5, Target.Value
    End Select
End Sub

Sub FillCells(arr, iVal)
    Dim i As Integer
    Application.EnableEvents = False
    For i = 1 To UBound(arr)
        If arr(i) <> "x" Then Sheets(i).Range(arr(i)) = iVal
    Next
    Application.EnableEvents = True
End Sub
Изменено: maxrus163 - 21.11.2017 13:54:31
 
 
 
#18
21.11.2017 14:22:36
Разобрался. Все диапазоны должны быть одинаковы по размеру. Добавил в конце "x" -ов там, где их не хватает. )
 
 
 
#19
22.11.2017 02:52:52
Будьте внимательнее.
Цитата
Важно, чтобы порядок адресов в массивах соответствовал соответствующему  листу и количество элементов массивов равнялось количеству листов.
Чем шире угол зрения, тем он тупее.
 
 
 
#20
23.11.2017 07:20:38
Все работает! Создал 20 групп из 19 ячеек в каждой на 117 листах.Очень рад! Спасибо форуму! SAS888 поблагодарю в личке )
 
 
 
#21
26.02.2018 18:56:20
SAS888, приветствую Вас! Прошу помощи все по этой же теме. Макрос благополучно функционировал, когда были связаны ячейки на 117 листах. Но сегодня понадобилось добавить в книгу еще 54 листа (в итоге стало 171). Макрос я отредактировал, естественно он потяжелел и VBA отказался его обрабатывать с ошибкой: Procedure too large. Можно ли его как-то оптимизировать? Макрос лежит в "Эта Книга". Скидываю ссылку на оригинальный файл https://yadi.sk/d/ENubvKY43SnwS3
Загрузить сюда не удалось (размер более 2 MB)
 
 
 
#22
01.03.2018 08:43:03
См. личные сообщения.
Чем шире угол зрения, тем он тупее.
 
 
 
Страницы: 1
Наверх