Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 214 След.
Макрос: несколько условий, вставка в другой лист, исключая пустые ячейки
 
Цитата
макрос выдавал ошибку.
В примере из сообщения #5?
Макрос в стандартный модуль, запускать при активном листе Проба
Макрос: несколько условий, вставка в другой лист, исключая пустые ячейки
 
EAV,
Цитата
Прописала для каждой строки
А мой макрос не подошел?
Поиск дублей в книге, Как найти дубли во всей книге
 
Цитата
Помогите люди добрые, а то она ночует тут... 78 групп
Это вы о себе в третьем лице говорите?
Цитата
нужно каждую неделю при составлении расписания смотреть чтоб не поставить пару в занятый кабинет или занятому преподу.  
Есть книга С. М. Кашаев, СПб БХВ-Петербург,2007
«Программирование в Microsoft Excel на примерах»
Там есть глава 6, которая посвящена этому "Управление фондом аудиторий учебного заведения "
Анализ текста регулярными выражениями (RegExp), поиск по раскладке- русский алфавит не ищет, только принудительно, через |
 
Так разве в той теме https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=122751
мы это не выяснили?
Код
.IgnoreCase = True
     .Pattern = "[A-Z]\d{1,2}(?=\s?[XХ])"
Извлечь латиницу и цифры формулой из текста
 
Цитата
убрать кириллицу.
UDF
Код
Function iRusDel(cell$)
 With CreateObject("VBScript.RegExp")
     .Global = True
     .IgnoreCase = True
     .Pattern = "[\sА-ЯЁ]+"
     iRusDel = .Replace(cell, "")
 End With
End Function
Генерация GUID в Excel
 
А почему не добавить явный вывод, например в А1
Код
        If retValue = guidLength Then ' valid GUID as a string
            CreateGuidString = strGuid
            Range("A1") = strGuid
        End If
Перебор критериев фильтра по списку на отдельном листе
 
Я имел в виду, что остальные переменные будут Variant
Перебор критериев фильтра по списку на отдельном листе
 
Raccoon_s,
При объявлении переменных как у вас
Код
Dim iCol, iCol1, iCol2, LastRow As Long

только LastRow будет Long
Сделайте цикл по вашим критериям, что-то типа
Код
Sub test()
    Sheets("Лист1").Activate
Dim iCol, iCol1, iCol2, LastRow As Long
Dim r, r1 As Range
Dim myV As String
Dim myV1 As Variant
      Set r = Range("A1").CurrentRegion
    iCol1 = r.Find("Город", LookIn:=xlValues).Column
    iCol2 = r.Find("Этажность", LookIn:=xlValues).Column
  For i = 2 To 4
    myV = Sheets("Лист2").Cells(i, "A")    'город
    myV1 = Sheets("Лист2").Cells(i, "C")    'этажность
      r.AutoFilter Field:=iCol1, Criteria1:=myV
      r.AutoFilter Field:=iCol2, Criteria1:=myV1
      Worksheets.Add.Name = myV & "_" & myV1
      [a1] = ActiveSheet.Name
    Sheets("Лист1").Activate
    r.AutoFilter
   Next
End Sub
Найти совпадения в столбце с имеющимся значением и указать их адреса, Значение J1 найти в столбце B и адреса всех совпавших ячеек вынести в столбец I
 
Код
Sub FIO()
Dim iFIO As String
Dim FirstFIO As String
Dim FoundFIO As Range
Dim iLR As Long
  Range("J2:J" & Cells(Rows.Count, "J").End(xlUp).Row + 1).ClearContents
        iFIO = Cells(1, "J")
            Set FoundFIO = Columns("B").Find(iFIO, , xlValues, xlWhole)
        If Not FoundFIO Is Nothing Then
            FirstFIO = FoundFIO.Address
            Do
              iLR = Cells(Rows.Count, "J").End(xlUp).Row + 1
              Cells(iLR, "J") = FoundFIO.Address
                Set FoundFIO = Columns("B").FindNext(FoundFIO)
            Loop While FoundFIO.Address <> FirstFIO
        Else
            Cells(2, "J") = "Нет такой фамилии в столбце B"
        End If
End Sub
Определение последней заполненной ячейки для активного листа
 
Посмотрите https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=8&TID=7493
Объединение одинаковых ячеек и конкатенация данных их соседних ячеек
 
Код
Sub iSumFIO()
Dim dic As Object
Dim i&
     Set dic = CreateObject("scripting.dictionary")
  For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
    dic.Item(Cells(i, "A").Text) = dic.Item(Cells(i, "A").Text) + Cells(i, "B") & ", "
  Next i
    Range("C1").Resize(dic.Count, 2) = Application.Transpose(Array(dic.keys, dic.Items))
  For i = 1 To Cells(Rows.Count, "D").End(xlUp).Row
    Cells(i, "D") = Left(Cells(i, "D"), Len(Cells(i, "D")) - 2)
  Next
End Sub
Поиск поставщиков с минимальными ценами из заданного диапазона по параметру города и виду загрузки авто
 
Цитата
как вывести все наименьшие цены + наименование поставщика
По каждому продукту отдельно?
поставить пробел между текстом и цифрой с определённой буквой, в конце теста иногда встречаются прикреплённые цифры, их нужно отделить
 
Цитата
где тут эти цифры есть?
d{1,2} от 1 до 2 цифр
поставить пробел между текстом и цифрой с определённой буквой, в конце теста иногда встречаются прикреплённые цифры, их нужно отделить
 
Код
Cells(i, "E") = .Replace(Cells(i, "E"), "$1 $2")
Макрос: несколько условий, вставка в другой лист, исключая пустые ячейки
 
EAV,
Цитата
Макрос написала
Поделитесь с форумом
поставить пробел между текстом и цифрой с определённой буквой, в конце теста иногда встречаются прикреплённые цифры, их нужно отделить
 
Цитата
куда его девать в моем случае неизвестно.
Код
Sub Razdel()
Dim iLastRow As Long
Dim i As Long
iLastRow = Cells(Rows.Count, "E").End(xlUp).Row
 With CreateObject("VBScript.RegExp")
     .IgnoreCase = True
     .Pattern = "([A-Z])(\d{1,2})(?=\s?[хx])"
   For i = 18 To iLastRow
     Cells(i, "AF") = .Replace(Cells(i, "E"), "$1 $2")
   Next
 End With
End Sub
Вставка формулой несимметричной галочки
 
Цитата
5 квадратов  :(
Латинская a в формуле
В ячейке, где формула, выбрать шрифт Marlett
Изменено: Kuzmich - 15 Ноя 2019 15:10:33
поставить пробел между текстом и цифрой с определённой буквой, в конце теста иногда встречаются прикреплённые цифры, их нужно отделить
 
Домкрат, написал
Цитата
если в тексте нет сочетания цифра+ X
хотя в первом сообщении явно указано
Цитата
после цифры идет знак(буква): x, X, с пробелом или без
На ваш запрос и был дан ответ
Вставка формулой несимметричной галочки
 
Код
=ЕСЛИ(ИЛИ($A1="кран";$A1="автобус");"a";"")

латинская a , шрифт Marlett
Макрос: несколько условий, вставка в другой лист, исключая пустые ячейки
 
Для вашего примера из сообщения #5
Макрос запускать при активном листе Проба
Код
Sub Perenos()
Dim i As Long
Dim iLastRow As Long
Dim iLR As Long
    iLastRow = Cells(Rows.Count, 1).End(xlUp).Row + 3
  With Worksheets("Данные")
    iLR = .Cells(.Rows.Count, 1).End(xlUp).Row
    For i = 6 To iLR
      If .Cells(i, 3) > Cells(1, 1) Then
        .Range("A" & i & ":B" & i).Copy Cells(iLastRow, 2)
        iLastRow = Cells(Rows.Count, 2).End(xlUp).Row + 1
      End If
    Next
  End With
End Sub
Изменено: Kuzmich - 15 Ноя 2019 12:06:52
поставить пробел между текстом и цифрой с определённой буквой, в конце теста иногда встречаются прикреплённые цифры, их нужно отделить
 
Андрей VG, написал
Цитата
Просто сделал на всякий случай и для кириллической х
Так у меня в паттерне так и было
поставить пробел между текстом и цифрой с определённой буквой, в конце теста иногда встречаются прикреплённые цифры, их нужно отделить
 
Цитата
а если просто макрос с началом и концом таблицы
Так переделайте UDF в макрос
поставить пробел между текстом и цифрой с определённой буквой, в конце теста иногда встречаются прикреплённые цифры, их нужно отделить
 
Андрей VG, Согласен, только паттерн надо поменять
Код
     .Pattern = "([A-Z])(\d{1,2})(?=\s?[хx])"

видимо при копировании произошел сбой
поставить пробел между текстом и цифрой с определённой буквой, в конце теста иногда встречаются прикреплённые цифры, их нужно отделить
 
UDF в стандартный модуль, в нужную ячейку вставляете =iTowar(E18) и протягиваете вниз
поставить пробел между текстом и цифрой с определённой буквой, в конце теста иногда встречаются прикреплённые цифры, их нужно отделить
 
UDF
Код
Function iTowar(cell$)
 With CreateObject("VBScript.RegExp")
     .Global = True
     .IgnoreCase = True
     .Pattern = "[A-Z]\d{1,2}(?=\s?[XХ])"
     iTowar = Left(cell, .Execute(cell)(0).FirstIndex + 1) & " " & Mid(cell, .Execute(cell)(0).FirstIndex + 2)
 End With
End Function
Изменено: Kuzmich - 14 Ноя 2019 18:16:09
Макрос: несколько условий, вставка в другой лист, исключая пустые ячейки
 
Цитата
пытаюсь во всем разобраться сама, но что-то пошло не так
В примере нет никаких макросов. Где ваши попытки?
На листе Общий приведите пример как должен выглядеть результат для дат в А2 и в А14.
Ячейки с определенным наименованием заполнять при соблюдении условий
 
Цитата
хотелось бы автоматизировать этот процесс
Код
Sub Nomer_TM()
Dim FoundModel As Range
Dim i As Long
Dim iLastRow As Long
  iLastRow = Range("A1").End(xlDown).Row
    Range("B3:C" & iLastRow).ClearContents
  For i = 3 To iLastRow
    Set FoundModel = Columns(6).Find(Split(Cells(i, 1), " ")(0), , xlValues, xlWhole)
    Cells(i, 3) = FoundModel.Offset(, 1)
    Cells(i, 2) = Columns(6).FindNext(FoundModel).Offset(, 1)
  Next
End Sub
Взять значения из одной ячейки и вставить их в другую после 4 символа
 
Код
Sub iPrice()
Dim i As Long
Dim iLastRow As Long
  iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
Dim iPrice As String
   Range("C3:C" & iLastRow).ClearContents
 With CreateObject("VBScript.RegExp")
   .Pattern = "\d+\.\d+"
     For i = 3 To iLastRow
      iPrice = .Execute(Cells(i, 1))(0)
      Cells(i, 3) = Cells(i, 1)
      Cells(i, 3).Replace what:=iPrice, replacement:=Left(Cells(i, 2), Len(Cells(i, 2)) - 2)
     Next
 End With
End Sub
Преобразовать дату в виде текста в нормальную дату
 
Кросс http://www.excelworld.ru/forum/10-43389-1
Удаления текста справа после определенного знака
 
Макросои
Код
Sub Tablica()
Dim i As Long
Dim iLastRow As Long
 iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
  For i = 1 To iLastRow
    Cells(i, 2) = Left(Cells(i, 1), InStrRev(Cells(i, 1), "/") - 1)
  Next
End Sub
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 214 След.
Наверх