Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Пользователи » VadimSh
Выбрать дату в календаре…Выбрать дату в календаре

Страницы: 1 2 След.
Имена умных таблиц, Как при помощи VBA задать имена Умных таблиц, используя Имя Листа и значение из Умной таблицы
 
#
29.03.2026 16:29:11
Старичок, Sanja спасибо большое!!!
 
Перейти    
Имена умных таблиц, Как при помощи VBA задать имена Умных таблиц, используя Имя Листа и значение из Умной таблицы
 
#
29.03.2026 13:07:59

Добрый день!

Помогите пожалуйста с вопросом автоматического переименования всех Умных таблиц на листе, используя Имя Листа и значения из первой ячейки каждой таблицы. С переименованием от значения первой ячейки из таблицы работает.

Код
Sub Кнопка1_Щелчок()

    Dim t As ListObject

    For Each t In ActiveSheet.ListObjects
        t.Name = Replace(t.Range(1, 1), 1, 1)

    Next
End Sub

В итоге имя Таблицы должно быть: ИмяЛиста+значение из 1-ой ячейки Таблицы.

Изменено: VadimSh - 29.03.2026 13:10:18
 
Перейти    
[ Закрыто] Сводные таблицы
 
#
26.01.2026 17:40:55

Уважаемые форумчане, добрый день!

Мне поставили задачу сделать таблицу с подведением промежуточных итогов в конце каждого месяца и с общим итогом по всему году в конце таблицы. Решил сделать на основе умных (сводных таблиц) по каждому месяцу года. Что-то у меня получилось, но 3 вопроса решить не могу. Может я изначально пошел не по тому пути и есть другое решение? Помогите пожалуйста с решением (советом).

1. Перенос значений из СтрокиВводаДанных  в сводную таблицу по соответствующему месяцу у меня получилось, хотя все так сложно реализовано (Сводная таблица на основе Умной Таблицы, в ней поименованный диапазон и еще пришлось добавить строку разделитель, который потом приходиться скрывать. Если можно это все упростить буду очень благодарен).  Но это не главное - нужно чтобы при изменении даты из столбца «Срок поставки до» в любой таблице строка переносилась в соответствующую месяцу Сводную (умную) таблицу.

2. При добавлении новой строки в Умную таблицу (и соответственно Сводную) количество строк между таблицами остается одинаковой (сдвигаются вниз), но при обновлении итоговых данных в Сводной таблице количество строк между таблицами уменьшается пока таблица на начинает наезжать на таблицу снизу. В идеале пустых строк между таблицами быть не должно. Можно конечно между ними вставить необходимое количество пустых строк, а затем скрыть пустые, но может быть есть более изящное решение.

3. Не получается собрать итоговые данные из всех сводных таблиц.                
 
Перейти    
Развертывание группы функцией
 
#
10.10.2024 15:16:21

Добрый день, МатросНаЗебре очень помог, спасибо ему огромное.

Задача усложнилась. Когда в структуре группировка 1 уровня, все работает как нужно – при двойном клике на ячейку раскрывается группа, находящаяся на 1 строку ниже. Но теперь в структуре есть группировка 2 уровня. Задача состоит в том, чтобы при двойном клике:

1.       На ячейку «1 группа» раскрывался/скрывался список подгрупп из «1 группы» - «1.1 подгруппа», «1.2 подгруппа», «1.3 подгруппа» и т.д., при этом данные в подгруппах не раскрывались.

2.       На ячейку «1.1 подгруппа» раскрывались/скрывались данные только из данной подгруппы.

Подскажите это реализуемо?
 
Перейти    
Развертывание группы функцией
 
#
04.10.2024 12:45:56
Цитата
написал:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   Dim cEnd As Range
   
   Dim yy As Long
   For yy = Target.Row + 1 To ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
       If Rows(yy + 1).OutlineLevel <> Rows(Target.Row + 1).OutlineLevel Then
           Range(Cells(Target.Row + 1, 1), Cells(yy, 1)).EntireRow.Hidden = Not Rows(Target.Row + 1).Hidden
           Exit For
       End If
   Next
End Sub
МатросНаЗебре, спасибо большое. Все отлично работает.
 
Перейти    
Развертывание группы функцией
 
#
04.10.2024 10:35:29
Добрый день!

Помогите решить задачку. Есть код на развертывание/свертывание всех групп на листе. Все работает, но нужно чтобы развертывание происходило только для одной конкретной группы, находящейся на 1 строку ниже ячейки (двойной клик).
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

'скрыть все
'ActiveSheet.Outline.ShowLevels 1, 1

'раскрыть все
ActiveSheet.Outline.ShowLevels 2, 1

End Sub
 
Перейти    
Скрытие строк по условию, Скрытие строк по условию в выделенном диапазоне
 
#
23.05.2024 14:47:55
Цитата
написал:
КодSub HideEmptyCellInRanges()
Vokilook, большое спасибо за помощь все работает!!!

Выкладываю файл. Может кому пригодится
 
Перейти    
Скрытие строк по условию, Скрытие строк по условию в выделенном диапазоне
 
#
22.05.2024 14:02:21
Файл прилагаю
 
Перейти    
Скрытие строк по условию, Скрытие строк по условию в выделенном диапазоне
 
#
22.05.2024 13:59:43
Не работает: ошибки не выдает, но и ничего не скрывает
 
Перейти    
Скрытие строк по условию, Скрытие строк по условию в выделенном диапазоне
 
#
21.05.2024 15:50:40
Цитата
написал:
По поводу Цитата VadimSh  написал:столбцы часто меняются и приходится каждый раз править кодСоздаём дополнительный лист где указываем какие столбцы берём в условие. Подробнее разберётесь в моём файле примере. Удачи.
И по второму вопросу решение не подходит. Нет большой разницы править названия столбцов (для выполнения условий отбора на скрытие строк) в коде или в ячейке на отдельном листе. Необходимо чтобы при добавлении/удалении/перемещении столбцов пользователем код работал правильно. Решение наверное только в создании имен столбцов "Именованный диапазон", но как это внедрить в код?
Код
     If WorksheetFunction.CountA(Range("D" & i & ":H" & i)) = 0 _
     And WorksheetFunction.CountA(Range("J" & i & ":J" & i)) = 0 _
Спасибо заранее
 
Перейти    
Скрытие строк по условию, Скрытие строк по условию в выделенном диапазоне
 
#
21.05.2024 15:39:22
MikeVol, спасибо за ответ, но это не решает мою проблему. Может я плохо описал задачу. В моем файле кнопка "Скрыть пустые"
Код
Sub СкрытьПустые()
Dim i&
Application.ScreenUpdating = False
    For i = 30 To Cells(Rows.Count, 1).End(xlUp).Row   'Определяем что скрытие пустых строк начнется с 30 строки
    'Далее определяем какие диапазоны столбцов мы отслеживаем, если во всех указанных диапазонах пусто, то идет скрытие строки
     If WorksheetFunction.CountA(Range("D" & i & ":H" & i)) = 0 _
     And WorksheetFunction.CountA(Range("J" & i & ":J" & i)) = 0 _
     And WorksheetFunction.CountA(Range("L" & i & ":L" & i)) = 0 _
     And WorksheetFunction.CountA(Range("N" & i & ":P" & i)) = 0 _
     And WorksheetFunction.CountA(Range("R" & i & ":R" & i)) = 0 _
     And WorksheetFunction.CountA(Range("T" & i & ":V" & i)) = 0 _
     And WorksheetFunction.CountA(Range("X" & i & ":Y" & i)) = 0 _
     And WorksheetFunction.CountA(Range("AA" & i & ":AA" & i)) = 0 Then
     Rows(i).EntireRow.Hidden = True
    End If
    Next
Application.ScreenUpdating = True
End Sub
скрывает все строки, начиная с 30 при условии что данные в столбцах  "D", "Е", "F", "G", H" ... и т.д. не пустые. Все работает правильно, но при большом объеме данных скрытие выполняется очень долго (500 строк - более 30 секунд). А данная операция выполняется часто.

Для ускорения решил скрывать и отображать строки только в указанном пользователем диапазоне строк. Для этого на кнопку "Скрыть пустые строки диапазона" вывел форму запроса "UserForm", которая предлагает пользователю выделить необходимый диапазон строк, где необходимо скрыть строки. При выделении строк и подтверждении выполняется
Код
Sub СкрытьПустыеДиапазона2()
    Dim i1 As Long, i2 As Long
    Application.ScreenUpdating = False
    i1 = Selection.Cells(1).Row  'Определяем переменную i1 - первая строка выделенного диапазона
    i2 = Selection.Cells(Selection.Cells.Count).Row   'Определяем переменную i2 - последняя строка выделенного диапазона
    Rows(i1).Resize(i2 - i1 + 1).Hidden = True 'Скрываются строки в диапазоне. 
    Application.ScreenUpdating = True

End Sub
Все работает, но скрываются все строки выделенного диапазона, но мне нужно что-бы скрывались только строки из выделенного диапазона с условием, что данные в столбцах  "D", "Е", "F", "G", H" ... и т.д. (как в первой коде) не пусты. То есть мне надо в 2-й код внедрить условия выполнения из 1-го кода  
 
Перейти    
Скрытие строк по условию, Скрытие строк по условию в выделенном диапазоне
 
#
17.05.2024 16:30:53

Уважаемые форумчане, добрый день!

Мучаюсь второй день, не могу реализовать задачу.

Макрос на кнопке «Скрыть пустые» скрывает все строки, начиная с 30 строки и до конца таблицы по при условии пустых ячеек в определенных столбцах

Код
Sub СкрытьПустые()
Dim i&
Application.ScreenUpdating = False
    For i = 30 To Cells(Rows.Count, 1).End(xlUp).Row   'Определяем что скрытие пустых строк начнется с 30 строки
    'Далее определяем какие диапазоны столбцов мы отслеживаем, если во всех указанных диапазонах пусто, то идет скрытие строки
     If WorksheetFunction.CountA(Range("D" & i & ":H" & i)) = 0 _
     And WorksheetFunction.CountA(Range("J" & i & ":J" & i)) = 0 _
     And WorksheetFunction.CountA(Range("L" & i & ":L" & i)) = 0 _
     And WorksheetFunction.CountA(Range("N" & i & ":P" & i)) = 0 _
     And WorksheetFunction.CountA(Range("R" & i & ":R" & i)) = 0 _
     And WorksheetFunction.CountA(Range("T" & i & ":V" & i)) = 0 _
     And WorksheetFunction.CountA(Range("X" & i & ":Y" & i)) = 0 _
     And WorksheetFunction.CountA(Range("AA" & i & ":AA" & i)) = 0 Then
     Rows(i).EntireRow.Hidden = True
    End If
    Next
Application.ScreenUpdating = True
End Sub

Кнопка «Отобразить все» возвращает все обратно.

Код
Sub ОтобразитьПустые()
Rows("30:9999").Hidden = False  'Показать скрытые строки в диапазоне 

End Sub
При заполнении данными макрос выполняется очень
долго (несколько минут). Решил облегчить задачу и выполнять скрытие строк
только в указанном через форму диапазоне по выбору пользователя – кнопка «Скрыть
пустые строки диапазона»
Код
Sub СкрытьПустыеДиапазона2()
    Dim i1 As Long, i2 As Long
    Application.ScreenUpdating = False
    i1 = Selection.Cells(1).Row  'Определяем переменную i1 - первая строка выделенного диапазона
    i2 = Selection.Cells(Selection.Cells.Count).Row   'Определяем переменную i2 - последняя строка выделенного диапазона
    Rows(i1).Resize(i2 - i1 + 1).Hidden = True 'Скрываются строки в диапазоне. Почему так не понятно. Rows("i1:i2") не работает
    Application.ScreenUpdating = True

End Sub

Скрытие строк работает, но только внедрить условия (объединить эти два кода) не получается

Пробовал так
Код
Sub СкрытьПустыеДиапазона2()
    Dim i1 As Long, i2 As Long
    Application.ScreenUpdating = False
'    For i = 7 To Cells(Rows.Count, 1).End(xlUp).Row   'Определяем что скрытие пустых строк начнется с 7 строки
    i1 = Selection.Cells(1).Row  'Определяем переменную i1 - первая строка выделенного диапазона
    i2 = Selection.Cells(Selection.Cells.Count).Row   'Определяем переменную i2 - последняя строка выделенного диапазона
     If WorksheetFunction.CountA(Range("D" & i & ":H" & i)) = 0 _
     And WorksheetFunction.CountA(Range("J" & i & ":J" & i)) = 0 _
     And WorksheetFunction.CountA(Range("L" & i & ":L" & i)) = 0 _
     And WorksheetFunction.CountA(Range("N" & i & ":P" & i)) = 0 _
     And WorksheetFunction.CountA(Range("R" & i & ":R" & i)) = 0 _
     And WorksheetFunction.CountA(Range("T" & i & ":V" & i)) = 0 _
     And WorksheetFunction.CountA(Range("X" & i & ":Y" & i)) = 0 _
     And WorksheetFunction.CountA(Range("AA" & i & ":AA" & i)) = 0 Then
    Rows(i1).Resize(i2 - i1 + 1).Hidden = True 'Скрываются строки в диапазоне. 
    End If
'    Next
Application.ScreenUpdating = True

End Sub
не работает.

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

Заранее спасибо.
 
Перейти    
Напоминания в Excel, UBound вывод номера строки
 
#
05.02.2024 18:05:40
Спасибо большое!
 
Перейти    
Напоминания в Excel, UBound вывод номера строки
 
#
05.02.2024 11:40:03
Добрый день!
На форумах нашел готовое решение от пользователя 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
 
Перейти    
Диапазон переменной из значения ячейки
 
#
19.01.2024 17:41:01
Цитата
написал:
Или так:Код    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)
А как это внедрить в файл?
 
Перейти    
Диапазон переменной из значения ячейки
 
#
19.01.2024 15:08:47

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

из значений А1 – начало диапазона, А2 – конец диапазона      или сразу из А3 (весь диапазон)?
 
Перейти    
Диапазон переменной из значения ячейки
 
#
19.01.2024 15:06:47

Добрый день.

Есть код, который ставит флажок в ячейке по щелчку на данной ячейке.  Все работает хорошо, но при перемещении столбца или добавлении строк приходится вручную менять диапазон  ячеек (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
 
Перейти    
Умные и сводные таблицы, Сохранение данных, расположенных снизу умных и сводных таблиц при их расширении
 
#
10.10.2023 17:08:41
Данный вопрос закинул и на другие форумы:
[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]
 
Перейти    
Умные и сводные таблицы, Сохранение данных, расположенных снизу умных и сводных таблиц при их расширении
 
#
09.10.2023 21:59:17
Добрый вечер. Помогите пожалуйста решить проблему. На Листе 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) ничего не получается. Может быть есть другое решение?. Заранее спасибо
 
Перейти    
При клике по любой ячейке группы ставить / снимать метку в ячейке, при клике по заголовку ставить / снимать метку со всей группы
 
#
26.10.2019 00:06:38
Игорь спасибо большое
 
Перейти    
При клике по любой ячейке группы ставить / снимать метку в ячейке, при клике по заголовку ставить / снимать метку со всей группы
 
#
25.10.2019 16:46:42
Помогите пожалуйста с решением. Необходимо выделять галочками необходимые ячейки в диапазоне.
Необходимо чтобы:
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
 
Перейти    
Оценочная ведомость
 
#
09.10.2019 16:08:29

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

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

Помогите пожалуйста
 
Перейти    
Обновление данных листа после изменения ComboBox
 
#
13.05.2015 16:32:42
Использовал другой вариант. Все работает как надо
Код
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
 
#
13.05.2015 10:39:49
В Вашем файле ничего не работает. Не добавляются имена в список имен, не переименовываются и не сортируются листы, не обновлется обновление.
 
Перейти    
Обновление данных листа после изменения ComboBox
 
#
12.05.2015 19:03:46
На листе имеются ячейки 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 листы не переименовывается, не сортируются и не обновляется оглавление. Подскажите пожалуйста чего не хватает для обновления.
 
Перейти    
Создание списка листов книги с данными
 
#
29.04.2015 12:14:38
Спасибо
 
Перейти    
Создание списка листов книги с данными
 
#
29.04.2015 11:04:08
Названия листов книги меняются по значению 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
 
Перейти    
Вычисление с выборкой по диапазону
 
#
17.10.2010 12:11:04
Помогите с решением.  
Имеется оценочная ведомость по предметам.  
Необходимо вычислить итоговую оценку ученику при условии:  
"5" -  50% и более оценок по всем предметам "5"; по математике и физике только "5"; остальные - не ниже "4"  
"4" -  50% и более оценок по всем предметам "5" и "4"; по математике и физике не ниже "4"; остальные - не ниже "3"  
"3" -  менее 50% оценок по всем предметам "5" и "4"; остальные - не ниже "3"   или   1 оценка - "2", а остальные - "5" и "4", в т.ч по математике и физике  
"2" -  остальное  
Примечание:    
если возможно ссылки на математику и физику должны быть по названию предмета, а не по столбцу  
т.к. они в ведомости могут и не быть, или находится в другом столбце
 
Перейти    
Значение ячейки по названию листа в книге
 
#
02.12.2008 15:28:23
Нашел решение  
 
=ПСТР(ЯЧЕЙКА("filename";A1);НАЙТИ("]";ЯЧЕЙКА("filename";A1))+1;31)  
 
Всем спасибо за помощь
 
Перейти    
Значение ячейки по названию листа в книге
 
#
02.12.2008 13:22:45
{quote}{login=}{date=02.12.2008 01:16}{thema=}{post}Конкретизируйтё{/post}{/quote}Допустим, название листа - 2007, в результате в ячейка А1 должно быть 2007
 
Перейти    
Страницы: 1 2 След.
Наверх