Igger (Автор тем)

Автозаполнение Даты при изменении в ячейке

Пользователь

Сообщений: 71 Регистрация: 14.10.2017

25.12.2017 16:39:52

Здравствуйте
Имеется работающий код.

Код

Private Sub Worksheet_Change(ByVal Target As Range)
For Each Cell In Target
 If Not Intersect(Cell, Range("C4:C1000")) Is Nothing Then
  With Range("E" & Cell.Row)
     .Value = Now
     .EntireColumn.AutoFit
     End With
    End If
   Next Cell
End Sub

Код вставляет дату в столбец Е при изменении в какой-либо ячейке в столбце С.
Как сделать, чтобы дата не вставлялась(не обновлялась), если в ячейку столбца С вставляется ( "копировать-вставить") такое же значение, которое там и было?

Перейти

Автоматическая вставка даты при вставке нескольких значений столбца

Igger

Пользователь

Сообщений: 71 Регистрация: 14.10.2017

19.12.2017 22:03:41

Здравствуйте!
Что надо поменять и возможно ли? Ниже макрос для автоматической вставки даты последнего изменения в ячейке. Требуется, чтобы код просматривал изменения при копировании - вставке целого столбца?
Работает всё как надо при ручном изменении в ячейке, а также при вставке содержимого единичной ячейки. Не работает при вставке нескольких значений столбца одновременно.

Код

For Each cell In Target   'проходим по всем измененным ячейкам 
    If Not Intersect(cell, Range("C4:C1000";)) Is Nothing Then 
      With Range("A" & cell.Row) 
         .Value = Now 
         .EntireColumn.AutoFit 
      End With 
    End If 
 
   Next cell

Перейти

Поиск наибольшего и наименьшего по условиям

Igger

Пользователь

Сообщений: 71 Регистрация: 14.10.2017

15.12.2017 21:30:50

Здравствуйте.
Голову уже сломал, а может это просто для кого-то?
Имеются таблица из 6-ти столбцов
А - текст
В - искомое значение
С - Значение
D - Текст
E - Текст
F - значение
Нужна формула вставляющая в В значение соответствующее "определённому тексту" по условиям:
1. Если наибольшее значение соответствующее "определённому тексту" из столбца F не больше наименьшего соответствующего "определённому тексту" из столбца C. - вставляем его
2. Если наибольшее значение ссответствующее "определённому тексту" из столбца F больше наименьшего соответствующего "определённому тексту" из столбца C - вставляем наименьшее из столбца C
3 Если "определённого текста" нет в столбце D - возвращаем 0.

Изменено: Igger - 16.12.2017 00:05:16

Перейти

Подсчёт повторяющихся значений

Igger

Пользователь

Сообщений: 71 Регистрация: 14.10.2017

18.11.2017 01:29:17

Здравствуйте.
Может кто- нибудь подсказать, хотя бы направление поиска решения?

Лист 1
Есть три столбца
1-й - список фамилий, организованный в постоянно наполняемую БАЗУ
2-й столбец - победитель,
3-й столбец - проигравший.
2-й и 3-йстолбцы заполняются из организованных выпадающих списков БАЗЫ

Требуется организовать на отдельном листе общий счёт в каждой паре в визуально и функционально удобном варианте.
К примеру :
Лист2
столбец 1 - фамилия \ столбец 2 - ячейки с выпадающим списком фамилий \ столбец 3 - кол-во побед значения из столбца 1 \ столбец 4 -кол-во побед значения из столбца 2.
Причём это результат должен быть накапливающимся, так как на листе 1 в определённый промежуток времени данные пар ( победитель-проигравший) стираются и заполняются новыми.

База "Фамилии" уже организована и макросом переносится с листа "База" на Лист "Счета"

Заранее благодарю откликнувшихся!

Изменено: Igger - 18.11.2017 02:41:12

Перейти

Как отключить постоянную работу макроса?

Igger

Пользователь

Сообщений: 71 Регистрация: 14.10.2017

25.10.2017 11:42:51

Здравствуйте
Создаю отчёт макросом

Скрытый текст

Код

Sub Создание_отчета()
   
    Sheets("Отчет").Select
    Selection.AutoFilter Field:=2
    Range("B5:J1005").Select
    Selection.ClearContents
    Selection.AutoFilter Field:=2, Criteria1:="<>"
    Sheets("База").Select
    Range("B4:B1004").Select
    Selection.Copy
    Sheets("Отчет").Select
    Range("B5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("База").Select
        Range("C4:C1004").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Отчет").Select
    Range("D5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Range("A1").Select
    Sheets("Итог").Select
    Range("D3:D1003").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Отчет").Select
    Range("C5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Итог").Select
    Range("F3:F1003").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Отчет").Select
    Range("E5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Бонус").Select
    Range("D3:D1003").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Отчет").Select
    Range("F5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Итог").Select
    Range("G3:J1003").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Отчет").Select
    Range("G5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B4:J1005").Select
    Application.CutCopyMode = False
    Selection.Sort Key1:=Range("C5"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("A1").Select
    Sheets("База").Select
    Range("A1").Select
    Sheets("Бонус").Select
    Range("B1").Select
    Sheets("Итог").Select
    Range("A1").Select
    Sheets("Отчет").Select
    Selection.AutoFilter Field:=2, Criteria1:="<>"
    Range("B4:J1005").Sort Key1:=Range("C4"), Order1:=xlDescending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("A1").Select

    Sheets("Отчет").Select
    Selection.AutoFilter Field:=2
    Range("B5:J1005").Select
    Selection.ClearContents
    Selection.AutoFilter Field:=2, Criteria1:="<>"
    Sheets("База").Select
    Range("B4:B1004").Select
    Selection.Copy
    Sheets("Отчет").Select
    Range("B5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("База").Select
        Range("C4:C1004").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Отчет").Select
    Range("D5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Range("A1").Select
    Sheets("Итог").Select
    Range("D3:D1003").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Отчет").Select
    Range("C5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Итог").Select
    Range("F3:F1003").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Отчет").Select
    Range("E5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Бонус").Select
    Range("D3:D1003").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Отчет").Select
    Range("F5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Итог").Select
    Range("G3:J1003").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Отчет").Select
    Range("G5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B4:J1005").Select
    Application.CutCopyMode = False
    Selection.Sort Key1:=Range("C5"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("A1").Select
    Sheets("База").Select
    Range("A1").Select
    Sheets("Бонус").Select
    Range("B1").Select
    Sheets("Итог").Select
    Range("A1").Select
    Sheets("Отчет").Select
    Selection.AutoFilter Field:=2, Criteria1:="<>"
    Range("B4:J1005").Sort Key1:=Range("C4"), Order1:=xlDescending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("A1").Select
            
End Sub

Потом мне нужно работать с листом и книгой. А макрос постоянно работает, что-там меняет, считает при клике на любую ячейку на листе, и всё тормозит. Поможете?

Перейти

Автоматическая нумерация по условиям

Igger Пользователь Сообщений: 71 Регистрация: 14.10.2017	# 18.10.2017 10:57:08 Здравствуйте. Нужна автоматическая нумерация, как в приложенном файлике. Может кто-то помочь?
	Перейти

Макрос создания списка "каждый с каждым"

Igger

Пользователь

Сообщений: 71 Регистрация: 14.10.2017

14.10.2017 00:34:37

Здравствуйте
Подскажите пожалуйста решение!
Имеется спортивная таблица, где отображены встречи " каждый с каждым"
Из неё вручную вбиваю в два столбца два списка.

Например при участии 6 человек
А В
первый второй
первый третий
первый четвёртый
первый пятый
первый шестой

Необходимо далее автоматизировать процесс, чтобы при выделении заполненных ячеек и нажатии сочетания клавиш, макрос заполнял списки далее по принципу "каждый с каждым"

В результате должно получиться:
А В
первый второй
первый третий
первый четвёртый
первый пятый
первый шестой
второй третий
второй четвёртый
второй пятый
второй шестой
третий четвёртый
третий пятый
третий шестой
четвёртый пятый
четвёртый шестой
пятый шестой

причём необходимо, чтобы макрос работал для различного кол-ва участников.
От 3-х до 50-ти вероятно хватит.

Заранее благодарю!

Перейти