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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 26 След.
Microsoft TreeView Control, Установка Microsoft TreeView Control
 
Рискну предположить, что у Вас установлен Office 2016 x64, в котором данный контрол не поддерживается.
Установите либо x86, либо 2019.
Изменено: SAS888 - 18.02.2024 05:29:59
Чем шире угол зрения, тем он тупее.
Последняя строка в диапазоне
 
Можно так:
Для всех строк листа:
Код
MsgBox Cells.Find("*", [A1], xlValues, xlPart, xlByRows, xlPrevious).Row

Для столбца "AK":
Код
MsgBox [AK:AK].Find("*", [AK1], xlValues, xlPart, xlByRows, xlPrevious).Row
Изменено: SAS888 - 13.02.2024 08:23:21
Чем шире угол зрения, тем он тупее.
Отделение пустой ячейкой блоков с повторяющимися значениями, Нужно вставлять пустую ячейку каждый раз как меняется значение последующей ячейки через формулы
 
Здравствуйте. Можно с помощью макроса. Например так:
Код
Sub InsRows()
    Dim i As Long, x As Range
    Application.ScreenUpdating = False
    Set x = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    With Sheets(2)
        x.Copy .[A2]
        Set x = .Range(x.Address)
        For i = x.Row + x.Rows.Count - 1 To x.Row + 2 Step -1
            If x.Cells(i) <> x.Cells(i - 1) Then x.Cells(i).Insert
        Next
    End With
End Sub

Пример во вложении. Откройте файл и выполните макрос "Main".
Чем шире угол зрения, тем он тупее.
VBA. Скопировать один в один видимую сроку при наличии скрытых столбцов и использовании автофильтра.
 
Можно так:
Код
Sub qq()
    Dim i As Long, r1 As Long, r2 As Long
    r1 = 3
    r2 = ActiveSheet.UsedRange.Rows.Count + 1
    For i = 1 To 7: Cells(r2, i) = Cells(r1, i): Next
End Sub
Чем шире угол зрения, тем он тупее.
VBA | Как найти последнюю ячейку в столбце, в которой формулой выводится значение?
 
Методу Find можно указать, что искать: формулы, значения и т.д.
В Вашем случае так:
Код
MsgBox [A:A].Find("*", [A1], xlValues, , , xlPrevious).Row
Чем шире угол зрения, тем он тупее.
Макрос для Рандомного текста, Макрос
 
В постах №2 и №3 Вам были предложены пользовательские функции, которые применялись на рабочем листе.
Если нужен именно макрос, то можно так:
Код
Sub Random()
    Dim i As Long: Application.ScreenUpdating = False
    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        Cells(i, "H") = Randomize3(Cells(i, 1).Resize(, 7))
    Next
End Sub

Function Randomize3(Rng As Range) As String
    Dim a(), i As Long, j As Long, k As Long, x
    a = Application.Index(Rng.Value, 1, 0)
    For k = 1 To 1000
        i = Int(1 + (UBound(a) * Rnd))
        j = Int(1 + (UBound(a) * Rnd))
        x = a(i): a(i) = a(j): a(j) = x
    Next
    Randomize3 = Join(a)
End Function
Откройте прикрепленный файл и выполните макрос "Random".
В результате, в столбце "H" каждой строки в пределах рабочего диапазона (который определяется по последней заполненной строке в столбце "A") будет "смесь" из всех значений столбцов "A:G" этой строки.
Если Вам нужно что-то другое - опишите подробнее. Не экономьте слова.
Чем шире угол зрения, тем он тупее.
Макрос для Рандомного текста, Макрос
 
Можно так: забрать в массив требуемый диапазон, затем "перемешать" этот массив в случайном порядке.
В данном случае поменять местами два произвольных элемента массива 1000 раз будет вполне достаточно.
Код
Function Randomize3(Rng As Range) As String
    Dim a(), i As Long, j As Long, k As Long, x
    a = Application.Index(Rng.Value, 1, 0)
    For k = 1 To 1000
        i = Int(1 + (UBound(a) * Rnd))
        j = Int(1 + (UBound(a) * Rnd))
        x = a(i): a(i) = a(j): a(j) = x
    Next
    Randomize3 = Join(a)
End Function
Пример во вложении.
Чем шире угол зрения, тем он тупее.
при условии вставить данные в ячейку слева, с помощью vba или функции
 
Можно так:
Код
Sub InsertNull()
    On Error Resume Next
    [B:B].SpecialCells(4).Offset(, -1) = 0
End Sub
Отключение обработки ошибок - на случай, если в столбце "B" нет пустых ячеек.
Чем шире угол зрения, тем он тупее.
Определение символов в TextBox
 
Для TextBox-а на форме:
Код
Private Sub TextBox1_Change()
    If Len(TextBox1) > 5 Then
        If Right$(TextBox1, 5) Like ".####" Then
            'Ваше действие
        End If
    End If
End Sub
Чем шире угол зрения, тем он тупее.
Прозрачность кнопки на рабочем листе Excel
 
Установите свойство кнопки TakeFocusOnClick в состояние False.
Чем шире угол зрения, тем он тупее.
Выбор из выпадающего списка, с дальнейшей подстановкой значений в последующие ячейки, Нужна помощь в формировании бланка
 
В ячейку "AD22" листа "Бланк" вставьте формулу:
Код
 =ВПР(BD21;Данные!B2:C6;2)
Естественно, вместо указанного в формуле диапазона "B2:C6" подставьте требуемый.
Также, формат ячейки "AD22" установите "Дата".
Пример во вложении.
Изменено: SAS888 - 18.03.2022 04:57:16
Чем шире угол зрения, тем он тупее.
Элемент формы (сброс переключателя), На листах несколько полей с переключателями. Необходим возврат к исходному состоянию по нажатию кнопки.
 
Можно так:
Код
Sub qq()
    Dim sh As Shape
    For Each sh In ActiveSheet.Shapes
        If sh.AlternativeText = "Вариант 1" Then sh.ControlFormat.Value = 1
    Next
End Sub
Чем шире угол зрения, тем он тупее.
Вставка формулы макросом в диапазон ячеек
 
Например, так:
Код
 [D4].AutoFill Range("D4:D" & Cells(Rows.Count, "C").End(xlUp).Row), xlFillDefault
Чем шире угол зрения, тем он тупее.
Обработать значение переменной и оставить только последние цифры
 
Еще вариант:
Код
x = StrReverse(Val(StrReverse(folderPath)))
Чем шире угол зрения, тем он тупее.
как проверить существование листа с заданным именем?
 
Можно поступить проще: без всякой проверки удалять лист с требуемым именем, отключив обработчик ошибок.
Если лист существует, то он будет удален. Если нет, то ничего не произойдет.
Код
On Error Resume Next: Sheets("имя").Delete: On Error GoTo 0
Чем шире угол зрения, тем он тупее.
VBA. Удаление строк, в которых непустая ячейка в столбце
 
Есть и такой вариант:
Код
[M:M].SpecialCells(4).EntireRow.Delete
Чем шире угол зрения, тем он тупее.
Как удалить строчки под фильтром, кроме определённых?
 
Следующий макрос удалит все строки, кроме тех, в столбце "C" которых находится значение "Ксения".
Без явных циклов и без применения фильтров.
Код
Sub DelRows()
    Dim x As Range, y As Range
    Set x = Range("C2:C" & Cells(Rows.Count, 3).End(xlUp).Row + 1)
    Set y = x.Find("Ксения", LookAt:=xlWhole)
    If y Is Nothing Then x.EntireRow.Delete Else x.ColumnDifferences(y).EntireRow.Delete
End Sub
Пример во вложении.
Изменено: SAS888 - 21.08.2020 06:10:07
Чем шире угол зрения, тем он тупее.
Какой сделать ширину столбца, чтобы она была реально равна высоте строки?
 
"Квадратную" ячейку (ячейки) можно сделать так:
Код
Sub qq()
    Dim w As Integer: w = 3 'Задаем требуемый размер
    With [A1:F6] 'Задаем диапазон ячеек
        .ColumnWidth = w 'Устанавливаем ширину столбца
        .RowHeight = .Cells(1).Width 'Уравниваем высоту строки
    End With
End Sub
Чем шире угол зрения, тем он тупее.
Добавить проверку данных (=список) в ячейку по условию
 
Не верю (см. прикрепленный файл).
А где Ваш файл, в котором все это "не работает"?
Чем шире угол зрения, тем он тупее.
Добавить проверку данных (=список) в ячейку по условию
 
Например, так:
Код
Sub tSystem()
    Dim i As Long: Application.ScreenUpdating = False
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        Cells(i, 13).Validation.Delete: Cells(i, 13) = ""
        If Cells(i, 4) <> "" Then Cells(i, 13).Validation.Add xlValidateList, xlValidAlertStop, Formula1:="=Тип_системы"
    Next
End Sub
Изменено: SAS888 - 05.11.2019 05:01:31
Чем шире угол зрения, тем он тупее.
Поиск и выведение заданной комбинации чисел в разных ячейках идущих в ряд
 
Посмотрите один из возможных вариантов в прикрепленном файле. Откройте файл и нажмите кнопку "Найти".
Будет прозведен поиск всех последовательностей, указанных в столбце "C", а также их инверсных значений.
Количество значений и длина каждой строки для поиска - произвольные.
Результат поиска (первых попавшихся совпадений) будет помещен в столбцах "G:H".
Если требуется найти не только первое совпадение, а все имеющиеся в столбце, то укажите в каком виде требуется представить результат.
Изменено: SAS888 - 24.10.2019 06:24:30
Чем шире угол зрения, тем он тупее.
Как умножить элементы 2-х массивов, а результаты вывести в третий
 
Решение с помощью макроса. Без каких-либо циклов, проверок и сравнений:
Код
Sub MyMultiply()
    Dim x As Range: Application.ScreenUpdating = False
    Set x = Range("B2:B" & Cells(Rows.Count, 1).End(xlUp).Row)
    x.Offset(, 1).Value = x.Value
    x.Offset(, -1).Copy
    x.Offset(, 1).PasteSpecial xlPasteValues, xlMultiply
    On Error Resume Next 'На случай, если нет ячеек с текстом
    x.Offset(, 1).SpecialCells(2, 2).ClearContents
    On Error GoTo 0
End Sub
Пример во вложении. Откройте файл и выполните макрос "MyMultiply".
Чем шире угол зрения, тем он тупее.
Как собрать несколько столбцов в один без пустых ячеек?
 
Код
Sub qq()
    Application.ScreenUpdating = False: On Error Resume Next
    [B:B].SpecialCells(2).Copy Cells(Rows.Count, 1).End(xlUp).Offset(1)
    [C:C].SpecialCells(2).Copy Cells(Rows.Count, 1).End(xlUp).Offset(1)
    [A:A].SpecialCells(4).Delete xlUp
End Sub
Чем шире угол зрения, тем он тупее.
Удаление строк с одинаковыми ячейками (оставив первую и последнюю строки в блоке) в массиве из большого количества блоков
 
Активируйте любую ячейку в том столбце, по которому требуется удалить блоки строк и выполните следующий макрос:
Код
Sub DelRows()
    Dim i As Long, j As Long, k As Long, x As Range
    k = ActiveCell.Column
    Application.ScreenUpdating = False: i = 1
    Do While i < Cells(Rows.Count, k).End(xlUp).Row
        j = Columns(k).Find(Cells(i, k), SearchDirection:=xlPrevious).Row
        If j - i > 1 Then If x Is Nothing Then Set x = Rows(i + 1 & ":" & j - 1) _
            Else Set x = Union(x, Rows(i + 1 & ":" & j - 1))
        i = j + 1
    Loop
    If Not x Is Nothing Then x.Delete
End Sub
Изменено: SAS888 - 15.08.2019 10:56:18
Чем шире угол зрения, тем он тупее.
Удаление строк с одинаковыми ячейками (оставив первую и последнюю строки в блоке) в массиве из большого количества блоков
 
Можно макросом, без перебора строк:
Код
Sub DelRows()
    Dim i As Long, j As Long, x As Range
    Application.ScreenUpdating = False: i = 1
    Do While i < Cells(Rows.Count, 2).End(xlUp).Row
        j = [B:B].Find(Cells(i, 2), SearchDirection:=xlPrevious).Row
        If j - i > 1 Then If x Is Nothing Then Set x = Rows(i + 1 & ":" & j - 1) _
            Else Set x = Union(x, Rows(i + 1 & ":" & j - 1))
        i = j + 1
    Loop
    If Not x Is Nothing Then x.Delete
End Sub
Пример во вложении.
Чем шире угол зрения, тем он тупее.
Макрос ошибается при записи сокращенной даты, вместо августа 2019 выводит сентябрь 2019
 
Чтобы "убрать" последний Сентябрь, строку кода
Код
Do While j < DateAdd("m", 1, Date)
замените на
Код
Do While j <= Date
Изменено: SAS888 - 14.08.2019 12:12:16
Чем шире угол зрения, тем он тупее.
Макрос ошибается при записи сокращенной даты, вместо августа 2019 выводит сентябрь 2019
 
Не нужно в цикле For...Next изменять счетчик цикла "вручную".
Можно, например, так:
Код
Sub Учебный2()
    Dim k As Integer, j As Date
    j = #1/1/2017# ' дата начала анализа
    k = 5
    Do While j <= Date
        Cells(2, k) = Format(j, "mmmm yyyy")
        MsgBox Cells(2, k)
        j = DateAdd("m", 1, j)
        k = k + 1
    Loop
End Sub
Изменено: SAS888 - 14.08.2019 12:00:02
Чем шире угол зрения, тем он тупее.
копирование листа в книге
 
Например, так:
Код
Sub qq()
    If IsDate(Sheets(1).Name) Then
        Sheets(1).Copy Before:=Sheets(1)
        ActiveSheet.Name = CDate(Sheets(2).Name) + 1
    Else
        MsgBox "Имя 1-го листа - это не дата!"
    End If
End Sub
Чем шире угол зрения, тем он тупее.
Разделить столбец со словосочетаниями на два
 
Вариант, предложенный Юрий М  - предпочтительнее. Без всяких циклов и формул. Например, так:
Код
Sub qq()
    Dim x As Range
    Application.ScreenUpdating = False: Application.DisplayAlerts = False
    Set x = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    x.TextToColumns [B1], OtherChar:="-"
    x.Resize(, 3) = Application.Trim(x.Resize(, 3))
End Sub
Изменено: SAS888 - 06.08.2019 07:05:19
Чем шире угол зрения, тем он тупее.
Нужно с таблицы строки белого цвета вместе с данными скопировать на отдельный лист
 
Для Excel 2007 и выше, можно обойтись вообще без циклов.
Пример во вложении.
Изменено: SAS888 - 01.07.2019 09:41:30
Чем шире угол зрения, тем он тупее.
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 26 След.
Наверх