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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 216 След.
Поиск и замена по маске, Есть артикулы в тексте, нужно найти их по маске и заключить в скобки
 
Цитата
сработал последний паттерн
Сначала делаете цикл по первому паттерну, затем по второму
Поиск и замена по маске, Есть артикулы в тексте, нужно найти их по маске и заключить в скобки
 
Цитата
1. Удалить артикул по патерну
заменить строку
Код
Cells(i, 2) = .Replace(Cells(i, 1), "")

Цитата
2. Удалить все кроме артикула
Код
Cells(i, 2) = .Execute(Cells(i, 1))(0)
Поиск и замена по маске, Есть артикулы в тексте, нужно найти их по маске и заключить в скобки
 
Нет, так не пойдет. Будет использоваться последний паттерн
А что в .Pattern = "([A-Z]+2)" означает 2 ?
Изменено: Kuzmich - 5 Дек 2019 22:12:37
Поиск и замена по маске, Есть артикулы в тексте, нужно найти их по маске и заключить в скобки
 
Цикл по столбцу А
Код
Sub iMaska()
Dim i As Long
Dim iLastRow As Long
 iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
 Range("B1:B" & iLastRow).ClearContents
  With CreateObject("VBScript.RegExp")
     .Global = True
     .Pattern = "([A-Z]+-?[A-Z]+\d{2,3}([A-Z]+)?)"
    For i = 1 To iLastRow
     Cells(i, 2) = .Replace(Cells(i, 1), "($1)")
    Next
  End With
End Sub
Поиск и замена по маске, Есть артикулы в тексте, нужно найти их по маске и заключить в скобки
 
Цитата
можно ли использовать несколько патернов
Думаю, что можно
Поиск и замена по маске, Есть артикулы в тексте, нужно найти их по маске и заключить в скобки
 
Цитата
при выделение диапазона
Так примените макрос к Selection
Подстановка характеристик с других листов
 
А подошло мое решение в теме
https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=121492
Поиск и замена по маске, Есть артикулы в тексте, нужно найти их по маске и заключить в скобки
 
UDF
Код
Function Maska(cell$)
 With CreateObject("VBScript.RegExp")
     .Global = True
     .Pattern = "([A-Z]+-?[A-Z]+\d{2,3}([A-Z]+)?)"
     Maska = .Replace(cell, "($1)")
 End With
End Function
Единственное число в поле в дату, Массово добавить месяц и год ко всем необходимым полям
 
=ДАТАЗНАЧ(D5&"."&"09.2017")
или короче
=ДАТАЗНАЧ(D5&".09.2017")
Изменено: Kuzmich - 5 Дек 2019 18:03:07
Нужно выделить первые строки в ячейках, в которых по несколько строк.
 
Цитата
существует ли приём без использования макросов
Без макросов не знаю. А макросом попробуйте так
Код
Sub BoldFirstRow()
Dim i As Long
Dim iLastRow As Long
Dim n As Integer
 iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
 Range("A3:A" & iLastRow).Font.Bold = False
  For i = 3 To iLastRow
    n = InStr(1, Cells(i, 1), Chr(10))
    If Cells(i, 1) <> "" And n <> 0 Then
      Cells(i, 1).Characters(1, n).Font.Bold = True
    End If
  Next
End Sub
Как заменить весь текст в ячейке?
 
Код
ActiveCell.Value = "ok"
Как разбить строки по признаку
 
Код
Sub BlankRow()
Dim i As Long
Dim iLastRow As Long
 iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
  For i = iLastRow To 4 Step -1
    If Cells(i - 1, 1) <> Cells(i, 1) Then
      Rows(i).Insert
    End If
  Next
End Sub
Вставка значений в отфильтрованные (видимые) ячейки
 
Только недавно была ссылка
https://www.excel-vba.ru/chto-umeet-excel/kak-vstavit-skopirovannye-yachejki-tolko-v-vidimyeotfiltrovannye-yachejki/
Формат ячейки, при котором отображается прочерк или числовое значение без изменений
 
http://www.excelworld.ru/publ/hacks/formatting/format_user/63-1-0-141
Формат ячейки, при котором отображается прочерк или числовое значение без изменений
 
А такой пользовательский формат не подойдет? # ##0,0###; - # ##0,0###;"-"; @
Расчет стоимости часов исходя из месяца
 
Цитата
если будет два месяца буду вашим пользоваться
Так и для одного месяца тоже подходит
Расчет стоимости часов исходя из месяца
 
Цитата
если их будет три
Надо корректировать макрос
Расчет стоимости часов исходя из месяца
 
Для вашего примера из сообщения #20, макрос в стандартный модуль, попробуйте
Код
Sub Raschet()
Dim i As Long
Dim iLastRow As Long
Dim FirstDay As Date                   'первый день месяца
Dim EndDay As Date                     'последний день месяца
Dim BeginDate As Date                  'дата начала
Dim EndDate As Date                    'дата окончания
Dim DoKontsa As Double                 'от даты начала до конца месяца
Dim OtNachala As Double                'от начала месяца до даты окончания
Dim iSumma As Double
Dim KolDaysBegin As Integer            'кол-во дней в месяце начала
Dim KolDaysEnd As Integer              'кол-во дней в месяце окончания

  iLastRow = Cells(Rows.Count, "E").End(xlUp).Row
  Range("K3:L" & iLastRow).ClearContents
  Range("N3:P" & iLastRow).ClearContents
For i = 3 To iLastRow
  BeginDate = Cells(i, "E")            'время начала
    EndDate = Cells(i, "F")            'время окончания
    KolDaysBegin = Day(DateSerial(Year(BeginDate), Month(BeginDate) + 1, 1) - 1)
    KolDaysEnd = Day(DateSerial(Year(EndDate), Month(EndDate) + 1, 1) - 1)
  If Month(EndDate) - Month(BeginDate) = 1 Then
    EndDay = DateSerial(Year(BeginDate), Month(BeginDate) + 1, 1) 'последний день месяца начала
    DoKontsa = EndDay - BeginDate
    FirstDay = DateSerial(Year(EndDate), Month(EndDate), 1)      'первый день месяца конца
    OtNachala = EndDate - FirstDay
      iSumma = DoKontsa + OtNachala
  Else
    If Month(EndDate) = Month(BeginDate) Then
      If Month(BeginDate) = Month(Range("N2")) Then
         OtNachala = 0
         DoKontsa = EndDate - BeginDate
      End If
      If Month(BeginDate) = Month(Range("O2")) Then
         OtNachala = EndDate - BeginDate
         DoKontsa = 0
      End If
      iSumma = EndDate - BeginDate
    End If
  End If
      Cells(i, "K") = DoKontsa
      Cells(i, "L") = OtNachala
      Cells(i, "N") = Cells(i, "M") / KolDaysBegin * DoKontsa
      Cells(i, "O") = Cells(i, "M") / KolDaysEnd * OtNachala
      Cells(i, "P") = iSumma
Next
End Sub
Расчет стоимости часов исходя из месяца
 
БМВ,
Я не писал
Цитата
времени за рубль,
Пошли уже третьи сутки, а воз и ныне там. ТС опять ушел в кусты.
Изменено: Kuzmich - 1 Дек 2019 22:01:41
Расчет стоимости часов исходя из месяца
 
БМВ,
Я думаю, что ТС нужно 500 руб раскидать по месяцам пропорционально времени
Статус доступности номера при бронировании мест
 
Цитата
должен выводится интегральный показатель доступности («нет», «мало», «достаточно», «много»)
А как это зависит от количества свободных номеров? Много - это сколько?
Да , и почему свободных 2-мест. номеров типа Стандарт у вас получилось 3? У меня только 2.
Изменено: Kuzmich - 1 Дек 2019 16:53:46
Вставка данных из отфильтрованных строк в отфильтрованные, Не могу найти решения в сети(((
 
Цитата
из выделенных желтым цветом на место выделенное синим.  
А количество желтых и синих всегда равны при других фильтрах?
Расчет стоимости часов исходя из месяца
 
eva243,
А месяц окончания всегда следующий месяц после начала?
В восьмой строке примера Общее время перерыва у вас 191:04:00
а у меня получилось 88:34:00
Как снять защиту со всех xls,xlsm файлов если знаешь пароль?, Как снять защиту со всех xls,xlsm файлов если знаешь пароль?
 
Цикл по всем книгам в папке
В каждой книге цикл по всем листам книги
Код
Sub СнятиеЗащитыВсехЛистов()
Dim WSheet As Worksheet
  For Each WSheet In Worksheets
    With WSheet
      If WSheet.ProtectContents = True Then
        WSheet.Unprotect Password:="12345"
      End If
    End With
  Next
End Sub


Сохраняем книгу
Изменено: Kuzmich - 28 Ноя 2019 18:37:10
Вытащить ФИО из текста которое идёт перед индексом
 
Цитата
Вытащить ФИО из текста которое идёт перед индексом
UDF
Код
Function FIO$(cell$)
   With CreateObject("VBScript.RegExp")
     .Global = True
     .IgnoreCase = False
        .Pattern = "(([А-ЯЁ]+) ){3}(?=\d{6})"
     If .test(cell) Then
       FIO = .Execute(cell)(0)
     Else
       FIO = "В строке нет ФИО перед индексом"
     End If
   End With
End Function

Для индекса
Код
Function iIndex(cell$)
 With CreateObject("VBScript.RegExp")
   .Pattern = "\d{6}"
  If .test(cell) Then
    iIndex = .Execute(cell)(0)
  Else
    iIndex = "В строке нет почтового индекса"
  End If
 End With
End Function
Изменено: Kuzmich - 28 Ноя 2019 13:40:10
Удаление символов в числовых значениях выгруженных из 1С в определенном диапазоне во всех листах книги
 
Код
Function tt(cell As Double) As Double
   tt = Val(Replace(cell, ",", "."))
End Function
Вполнение макроса на все листы, одни и те же комманды
 
Игорь, конечно так проще
Создание новой строки с копированием формата и формул
 
Цитата
или с эталонной, в данном случае она 3-я).
В этой строке в ячейках, где формулы закрепите диапазон
=ВПР(E3;'все представители заказчиков'!$B$3:$C$16;2;ЛОЖЬ)
Вполнение макроса на все листы, одни и те же комманды
 
Код
Sub tt()
'Цикл по листам книги, кроме скрытых и очень скрытых 
Dim Sht As Worksheet                                 
 For Each Sht In Worksheets                         
   With Sht
    If Not Sht.Visible = xlSheetHidden And Not Sht.Visible = xlSheetVeryHidden Then
      .Range("L11:U41,L56:U86,L101:U131,L146:U176,L191:U221,L236:U266").ClearContents
    End If
   End With
 Next
End Sub
Изменено: Kuzmich - 25 Ноя 2019 22:50:51
[ Закрыто] макрос для гео-координат
 
А еще кросс https://www.excel-vba.ru/forum/index.php?topic=6135.0
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 216 След.
Наверх