Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Напоминания в Excel, UBound вывод номера строки
 
Спасибо большое!
Напоминания в Excel, UBound вывод номера строки
 
Добрый день!
На форумах нашел готовое решение от пользователя Gustav. Дайте пожалуйста маленькую подсказку как в сообщении после "Срок:" выводить еще и номер строки "Строка №" __
Код
Option Explicit
Dim wks As Worksheet
Dim Проект()        As Variant
Dim Исполнитель()   As Variant
Dim ДатаВып()       As Variant
Dim ДнейДо()        As Variant

Sub remindAtStartup()
    Dim Просрочено As String
    Dim i As Long
    Set wks = ThisWorkbook.Worksheets("Лист1")
    
    setArray Проект, "Проект"
    setArray Исполнитель, "Исполнитель"
    setArray ДатаВып, "ДатаВып"
    setArray ДнейДо, "СрокДо"
       
    'генерирование напоминаний
    Просрочено = ""
    
    For i = 1 To UBound(Проект)
        Select Case ДнейДо(i, 1)
            Case -9999 To -1
                Просрочено = _
                    Просрочено & _
                    Проект(i, 1) & ". " & _
                    (Chr(13)) & _
                    "Исполнитель: " & Исполнитель(i, 1) & ". " & _
                    (Chr(13)) & _
                    "Срок: " & ДатаВып(i, 1) & " г." & _
                    vbCrLf & vbCrLf
        End Select
    Next i
    'отображение всех напоминаний
    If Просрочено <> "" Then
        MsgBox Просрочено, vbCritical, "Просрочено"
    End If
End Sub

Sub setArray(ByRef arr As Variant, ByVal addr As String)
    ReDim arr(1 To wks.Range(addr).Rows.Count, 1)
    arr = wks.Range(addr).Value
End Sub
Спасибо заранее  
Изменено: VadimSh - 05.02.2024 11:41:30
Диапазон переменной из значения ячейки
 
Цитата
написал:
Или так:Код    Dim ws As Worksheet
   Dim rng As Range
   
   Set ws = ActiveSheet
   Set rng = ws.Range(ws.Cells(1, 1).Value & ":" & ws.Cells(2, 1).Value)
А как это внедрить в файл?
Диапазон переменной из значения ячейки
 

Как сделать, чтобы диапазон брался:

из значений А1 – начало диапазона, А2 – конец диапазона      или сразу из А3 (весь диапазон)?

Диапазон переменной из значения ячейки
 

Добрый день.

Есть код, который ставит флажок в ячейке по щелчку на данной ячейке.  Все работает хорошо, но при перемещении столбца или добавлении строк приходится вручную менять диапазон  ячеек (A5:A20).

Код
'CODE 1 Ставим флажок, если был одиночный щелчок по ячейке
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        If Target.Cells.Count > 1 Then Exit Sub
        If Not Intersect(Target, Range("A5:A20")) Is Nothing Then 'Если ячейка пересекается с указанным диапазоном, то
            Target.Font.Name = "Marlett"    'Назначаем ячейке шрифт
            If Target = vbNullString Then    'Если ячейка пуста, то
                Target = "a"     'заполняем её символом "а" (латиница)
            Else    'Иначе
                Target = vbNullString 'в ячейке пусто
            End If
            Target.Offset(0,1).Activate    '"отскакиваем" вправо на один столбец
        End If
   End Sub

Изменено: VadimSh - 19.01.2024 15:08:07
Умные и сводные таблицы, Сохранение данных, расположенных снизу умных и сводных таблиц при их расширении
 
Данный вопрос закинул и на другие форумы:
[url=https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=160509&... Excel[/url]
[url=https://forum.msexcel.ru/index.php?topic=12275.new#new]Профессиональные приемы работы в Microsoft Excel[/url]
[url=http://programmersforum.ru/showthread.php?t=346390]Клуб программистов[/url]
[url=http://www.excelworld.ru/forum/10-52487-1#342551]ExcelWorld.RU[/url]
Умные и сводные таблицы, Сохранение данных, расположенных снизу умных и сводных таблиц при их расширении
 
Добрый вечер. Помогите пожалуйста решить проблему. На Листе 1 имеется умная таблица, на Листе 2 - сводная. На листах снизу этих таблиц имеются данные, которые должны сохраниться и опускаться вниз при расширении данных таблиц. Нашел где-то решение для 2 умных таблиц, расположенных друг над другом. Вроде внедрил для Листа 2, но для этого пришлось заводить еще одну (пустую) умную таблицу. Но для Сводной (Лист 1) ничего не получается. Может быть есть другое решение?. Заранее спасибо

Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("Таблица1")) Is Nothing Then
        a = Target.Row
        b = Range("Таблица2").Row
        If b - a = 3 Then
            Rows(a + 1).Insert Shift:=xlDown
            Rows(a * 2 + 2).Insert Shift:=xlDown
        End If
    End If
End Sub

Но для Сводной (Лист 1) ничего не получается. Может быть есть другое решение?. Заранее спасибо

При клике по любой ячейке группы ставить / снимать метку в ячейке, при клике по заголовку ставить / снимать метку со всей группы
 
Игорь спасибо большое
При клике по любой ячейке группы ставить / снимать метку в ячейке, при клике по заголовку ставить / снимать метку со всей группы
 
Помогите пожалуйста с решением. Необходимо выделять галочками необходимые ячейки в диапазоне.
Необходимо чтобы:
1. При клике на любую ячейку в диапазоне E6:E33 ячейка принамала значение "а" (ставилась галочка). Повторное нажатие галочка убирается. Это работает на листе 2.
2. При клике на ячейку Е4 во всех ячейках диапазона E6:E33 проставлялась галочки. Повторное нажатие снималась у всех. Реализовано на листе 1.  
Сделать чтобы выполнялось и 1 и 2 условие не получается
Код
 'CODE 1 Ставим флажок, если был одиночный щелчок по ячейке
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
        If Not Intersect(Target, Range("E6:E33")) Is Nothing Then 'Если ячейка пересекается с указанным диапазоном, то
            Target.Font.Name = "Marlett" 'Назначаем ячейке шрифт
            If Target = vbNullString Then 'Если ячейка пуста, то
                Target = "a" 'заполняем её символом "а" (латиница)
            Else 'Иначе
                Target = vbNullString 'в ячейке пусто
            End If
            Target.Offset(0, 1).Activate '"отскакиваем" вправо на один столбец
        End If


          If Not Intersect(Target, Range("E4")) Is Nothing Then
                With Target
                .Font.Name = "Wingdings"
                 .Font.Size = 28
                If .Value = Chr(111) Then
                .Value = Chr(254)
                Else
                .Value = Chr(111)
                End If
                .Offset(0, 1).Select
            End With
    End If
    
                If Target = "ю" Then 'Если ячейка пуста, то
                Range("E6:E33").Value = "a" 'заполняем диапазон символом "а" (латиница)
            Else 'Иначе
                Range("E6:E33").Value = vbNullString  'в ячейке пусто
            End If
End Sub
Оценочная ведомость
 

Добрый день. Необходимо создать по предметам обучения.  На листе «! Данные» имеются уникальные кода сотрудников,  Фамилии, инициалы, подразделения и другие необходимые данные. Необходимо:

  1. Создать
        оценочные ведомости по отдельным предметам, где все фамилии и другая
        информация будут браться из листа «!Данные» и отсортированы по алфавиту.
  2. Информация
        из оценочных ведомостей по предметам должна попадать в сводную ведомость
        («форма 3»), а там группироваться по подразделениям и отсортированы по
        фамилиям.
  3. Количество
        записей (Ф.И.О.) в каждой группе и количество этих групп (подразделений) должно
        быть динамическим и браться из листа «!Данные»
  4. Из
        данных «Формы 3» формируется «Форма 4» и «Форма 5», где количество и
        названия подразделений берутся из листа «!Данные».

Помогите пожалуйста

Обновление данных листа после изменения ComboBox
 
Использовал другой вариант. Все работает как надо
Код
Private Sub ComboBox2_Change()
    bla ("$I$1")
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$G$1" Or Target.Address = "$I$1" Or Target.Address = "$K$1" Then
       bla (Target.Address)
    End If
End Sub

Private Sub ComboBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
    Case 13
        With Sheets("!!!Оглавление").Range("Имена")
            If ComboBox2.ListIndex = -1 Then .Offset(.Rows.Count).Resize(1) = ComboBox2.Text
        End With
End Select
End Sub

Sub bla(addr As String)
       If Range("N1").Value <> "" Then
             If Len(Range("N1").Value) < 30 Then
               If Range(addr).Parent.Name = Range("N1").Value Then Exit Sub
               Range(addr).Parent.Name = Range("N1").Value
             End If
       End If
       
        Dim i As Integer, j As Integer
        For i = 1 To Sheets.Count - 1
            For j = i + 1 To Sheets.Count
                If UCase(Sheets(i).Name) > UCase(Sheets(j).Name) Then
                    Sheets(j).Move before:=Sheets(i)
                End If
           Next j
        Next i
End Sub

Но выдает ошибку на строчку
Код
Range(addr).Parent.Name = Range("N1").Value
при копировании листа:
Run-time error '1004'.
Нельзя присвоить листу имя, совподающее с именем другого листа, библиотеки объектов или книги, на которую ссылается VisualBasic.
Обновление данных листа после изменения ComboBox
 
В Вашем файле ничего не работает. Не добавляются имена в список имен, не переименовываются и не сортируются листы, не обновлется обновление.
Обновление данных листа после изменения ComboBox
 
На листе имеются ячейки G1 (фамилия),  K1 (имя),  I1 (отчество), N1 (фамилия, инициалы). При обновлении любой из ячеек  лист автоматически переименовывается, листы сортируются и обновляется оглавление листов.

Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$G$1" Or Target.Address = "$I$1" Or Target.Address = "$K$1" Then
       If Range("N1").Value <> "" Then
             If Len(Range("N1").Value) < 30 Then
               Target.Parent.Name = Range("N1").Value
             End If
       End If
    End If
    
    Dim i As Integer, j As Integer
    For i = 1 To Sheets.Count - 1
        For j = i + 1 To Sheets.Count
            If UCase(Sheets(i).Name) > UCase(Sheets(j).Name) Then
                Sheets(j).Move before:=Sheets(i)
            End If
       Next j
    Next i
End Sub
 
Private Sub ComboBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
    Case 13
        With Sheets("!!!Оглавление").Range("Имена")
            If ComboBox2.ListIndex = -1 Then .Offset(.Rows.Count).Resize(1) = ComboBox2.Text
        End With
End Select
End Sub


Добавил поле со списком ComboBox, связанное с K1 с возможностью подстановки и добавления новых имен. Но при изменении ComboBox2 листы не переименовывается, не сортируются и не обновляется оглавление. Подскажите пожалуйста чего не хватает для обновления.
Создание списка листов книги с данными
 
Спасибо
Создание списка листов книги с данными
 
Названия листов книги меняются по значению N1 и  автоматически сортируются по алфавиту.  

Код
Private Sub Worksheet_Change(ByVal Target As Range) 
If Target.Address = "$G$1" Or Target.Address ="$I$1" Or Target.Address = "$K$1" Then
If Range("N1").Value <>"" Then
If Len(Range("N1").Value) < 30 Then
Target.Parent.Name =
Range("N1").Value
End If
End I   
End If
       
Dim i As Integer, j As Integer   
For i = 1 To Sheets.Count - 1
        For j = i + 1 To Sheets.Count
            If UCase(Sheets(i).Name) >UCase(Sheets(j).Name) Then
                Sheets(j).Move before:=Sheets(i)
            End If
       Next j   
Next i
End Sub
Имеется лист с названием всех листов книги (по алфавиту)
Код
=ЕСЛИ(ПРОВЕРКА;ГИПЕРССЫЛКА(ЛИСТ.СПИСОК&"'!A1";ЛИСТ.ИМЯ);"")


Необходимо к списку листов присоединить данные F10, K10, O10 всех листов. Помогите пожалуйста реализовать.
Изменено: VadimSh - 29.04.2015 11:06:16
Вычисление с выборкой по диапазону
 
Помогите с решением.  
Имеется оценочная ведомость по предметам.  
Необходимо вычислить итоговую оценку ученику при условии:  
"5" -  50% и более оценок по всем предметам "5"; по математике и физике только "5"; остальные - не ниже "4"  
"4" -  50% и более оценок по всем предметам "5" и "4"; по математике и физике не ниже "4"; остальные - не ниже "3"  
"3" -  менее 50% оценок по всем предметам "5" и "4"; остальные - не ниже "3"   или   1 оценка - "2", а остальные - "5" и "4", в т.ч по математике и физике  
"2" -  остальное  
Примечание:    
если возможно ссылки на математику и физику должны быть по названию предмета, а не по столбцу  
т.к. они в ведомости могут и не быть, или находится в другом столбце
Значение ячейки по названию листа в книге
 
Нашел решение  
 
=ПСТР(ЯЧЕЙКА("filename";A1);НАЙТИ("]";ЯЧЕЙКА("filename";A1))+1;31)  
 
Всем спасибо за помощь
Значение ячейки по названию листа в книге
 
{quote}{login=}{date=02.12.2008 01:16}{thema=}{post}Конкретизируйтё{/post}{/quote}Допустим, название листа - 2007, в результате в ячейка А1 должно быть 2007
Значение ячейки по названию листа в книге
 
Как получить значение ячейки по названию листа в книге
Ссылка на лист в функции в зависимости от значение ячейки
 
В функции имеется недостаток.  
При копировании строки не изменятся ссылка на ячейку B5    
=ДВССЫЛ($B$1&"!B5")+ДВССЫЛ($B$2&"!B5")  
при копировании должно получиться    
=ДВССЫЛ($B$1&"!B5")+ДВССЫЛ($B$2&"!B5")  
=ДВССЫЛ($B$1&"!B6")+ДВССЫЛ($B$2&"!B6") и т.д.
Ссылка на лист в функции в зависимости от значение ячейки
 
В книге имеются листы с названиями "2008 год", "2007 год", "2006 год" и т.д. В листе "Результаты" имеется формула например  =СУММ('2008'!B5;'2007'!B5;'2006'!B5 .....). Необходимо, что бы в формуле менялись названия листа в зависимости от значений в ячейке 'Результаты'!B1 и 'Результаты'!B2.  
Например в листе "Результаты" в ячейках В1 и В2 - 2008 и 2006 год соответственно. В результате должны просуммироваться значения В1 из листов "2008 год", и "2006 год" и т.д. Помогите пожалуйста это реализовать.
Количество дней в месяце по диапазону дат
 
Если можно помогите с моим файлом
Количество дней в месяце по диапазону дат
 
Имеется таблица со столбцами: "Фамилия И.О." - "Отпуск с" - "Отпуск по" - "Январь" -"Февраль" - ... "Декабрь".    
Допустим у сотрудника отпуск с 18.11.2008 г. по 15.12.2008 г.  
Должно получиться: в столбце "Ноябрь" результат - 13, в "Декабре" - 15
Количество дней в месяце по диапазону дат
 
Имеется диапазон дат  «отпуск с»  и «отпуск по»  
 
Необходимо для каждого месяца года выдать количество дней в отпуске
Страницы: 1
Наверх