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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 250 След.
Добавить условие в Split
 
Цитата
109x60*65
А кто-то напишет хХ в русской или латинской транскрипции или с пропусками 109 x 60 * 65
Поэтому мне кажется, что лучше применить регулярки
Код
Sub iRazner()
Dim i As Long
Dim mo As Object
Dim n As Integer
 With CreateObject("VBScript.RegExp")
     .Global = True
     .Pattern = "\d+"
For i = 2 To 7
   If .test(Cells(i, 1)) Then
     Set mo = .Execute(Cells(i, 1))
     For n = 0 To mo.Count - 1
       Cells(i, 2 + n) = Val(mo(n))
     Next
   Else
     Cells(i, 2) = ""
   End If
Next
 End With
End Sub
Удалить строку в умной таблице с помощью VBA
 
Allleksey,
Цитата
found - переменная не определена
Код
Dim found as Range
Отсортировать текст из ячейки по столбцам, Отсортировать текст из ячейки по столбцам
 
Евгений Смирнов,
Цитата
Просто я неверно бы
А надо верно писать
Отсортировать текст из ячейки по столбцам, Отсортировать текст из ячейки по столбцам
 
Цитата
в ячейке может быть и более 10 организаций
Вытаскиваем из ячейки А1 наименование организаций
Код
Sub iName()
Dim mo As Object
Dim n As Integer
 With CreateObject("VBScript.RegExp")
     .Global = True
     .MultiLine = True
     .Pattern = "Название (.+)(?= ИНН:)"
   If .test(Cells(1, 1)) Then
     Set mo = .Execute(Cells(1, 1))
     For n = 0 To mo.Count - 1
       Cells(1, 2 + n) = Mid(mo(n), 10)
     Next
   Else
     Cells(1, 1) = ""
   End If
 End With
End Sub

Дальше аналогично
Цикл по строкам столбца А, вытаскиваем нужное.
Изменение направления определения номера вхождения для функции ПОДСТАВИТЬ
 
seregasss435, написал
Цитата
есть ли другое решение отличающиеся от моего и если есть то какое ?
UDF
Код
Function iTag(cell$, n&)
Dim Delimiter As String
Dim mo As Object
   Delimiter = "supertag;"
 With CreateObject("VBScript.RegExp")
     .Global = True
     .Pattern = ";"
   If .test(cell) Then
     Set mo = .Execute(cell)
     If n <= mo.Count Then
       iTag = Mid(cell, 1, mo(n - 1).FirstIndex + 1) & Delimiter & Mid(cell, mo(n - 1).FirstIndex + 2)
     Else
       MsgBox "Место вставки " & Delimiter & "выходит за рамки строки"
     End If
   Else
     iTag = ""
   End If
 End With
End Function

Вызов =iTag(A1;2)
Выбор значения из всплывающего окна (таблицы с секторами хранения)
 
Вам нужно Меню - Данные - Проверка данных - Тип данных Список
Макрос скопировать значение вместо формулы и перенести в другую ячейку
 
Макрос срабатывает на событие Private Sub Worksheet_Change(ByVal Target As Range)
Вы изменяете значения в ячейке А4 или С4, вот на изменение этих ячеек и пишите макрос
Код
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("A4:C4")) Is Nothing Then
     Application.EnableEvents = False
       Range("E4").Copy
       Range("G4").PasteSpecial xlPasteValues
       Application.CutCopyMode = False
  End If
    Application.EnableEvents = True
End Sub
Макрос скопировать значение вместо формулы и перенести в другую ячейку
 
Код
Range("G4") = Range("A4") + Range("C4")
Посчитать количество ячеек, которое принадлежит значению
 
Для вашего примера
Код
Sub iСontainer()
Dim Rng As Range
Dim NomerСontainer As Long
Dim iLastRow As Long
  Columns("B:D").ClearContents
    iLastRow = 1
  For Each Rng In Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(2, 3).Areas
    If Rng.Cells(1) = "Контейнер" Then NomerСontainer = Rng.Cells(2)
    If Rng.Cells(1) = "SSCC/SN" Then
      Rng.Cells(0, 2) = "Контейнер " & NomerСontainer
      Rng.Cells(1, 2) = WorksheetFunction.CountA(Rng) - 1
      Rng.Cells(1, 2).NumberFormat = "#,##0"
      Cells(iLastRow, "C") = Rng.Cells(0, 2)
      Cells(iLastRow, "D") = Rng.Cells(1, 2)
      iLastRow = iLastRow + 1
    End If
  Next
    Cells(iLastRow, "C") = "Всего контейнеров: "
    Cells(iLastRow, "D") = WorksheetFunction.Sum(Range("D1:D" & iLastRow - 1))
End Sub
Получить дату на завтра в нестандартном формате даты,
 
Цитата
нужно сделать завтрашнюю дату в неформатной дате
Добавить день
Код
Function PlusDay(cell As String)
Dim temp As Date
   temp = CDate(cell) + 1
   PlusDay = WorksheetFunction.Text(Day(temp), "00") & "." & WorksheetFunction.Text(Month(temp), "00") & "." & Year(temp)
End Function
Range.Address. Как быстро получить длинный адрес диапазона, состоящего из множества областей
 
bedvit,
А, если взять пересекающиеся диапазоны
Код
Range("a1:a3, f3:g10, d1:f5").Select
Макрос форматирования ячейки удаляет формулу
 
Код
Range("A8") = " № 4 от " & Format(DateSerial(Year(Now), Month(Now) + 1, 1) - 1, "[$-FC22]DD MMMM 20 YY  " & "года")
Макрос форматирования ячейки удаляет формулу
 
Цитата
чтобы был последний день месяца
Какой даты?
Макрос форматирования ячейки удаляет формулу
 
Код
Range("A8") = " № 4 от " & Format(Now, "[$-FC22]DD MMMM 20 YY  " & "года")
Вытащить наименование населенного пункта (regexp)
 
Цитата
или слова начинающегося с прописной буквы
Код
д[.?\s?]([а-яА-ЯёЁ ]+){1,2}(?=,? [а-я]+)
Вытащить наименование населенного пункта (regexp)
 
Код
д[.?\s?]([а-яА-ЯёЁ ]+){1,2}(?=,? тер| ул\.|снт|д\.)
Вытащить наименование населенного пункта (regexp)
 
Mershik,
Я же вам давал ссылки на литературу
Если добавить
Код
 regex.ignorecase = True

д[.?\s?]([а-яё ]+){1,2}(?=,? тер)
Вытащить наименование населенного пункта (regexp)
 
д[.?\s?]([а-яА-ЯёЁ ]+){1,2}(?=,? тер)
Вставка символа перед числом
 
Если в ячейке abc12fjgkgl2flflfl8, то цифр четыре, а чисел три (12,2,8)
Преобразование таблицы. Данные одинаковых периодов разместить в одну строку.
 
Ігор Гончаренко,
35 лет работаю с Excel
Ты еще должен помнить Lotus 1-2-3  :D
Вставка символа перед числом
 
theseventhline,
Цитата
нужно перед каждым числом
Так перед числом или цифрой?
Как вычленить числа перед буквами из текстовой строки?
 
Код
Sub Tablica()
Dim i As Long
Dim j As Long
Dim iLastRow As Long
Dim Matches As Object
Dim re As Object
  iLastRow = Cells(Rows.Count, 3).End(xlUp).Row
   Set re = CreateObject("VBScript.RegExp")
     re.Global = True
     re.Pattern = "\d+[А-Ж]"
     Range("E5:K8") = 0
  For i = 5 To iLastRow
    Set Matches = re.Execute(Cells(i, "C"))
    For j = 0 To Matches.Count - 1
            Select Case Right(Matches.Item(j), 1)
        Case "А"
          Cells(i, "E") = Cells(i, "E") + Left(Matches.Item(j), Len(Matches.Item(j)) - 1)
        Case "Б"
          Cells(i, "F") = Cells(i, "F") + Left(Matches.Item(j), Len(Matches.Item(j)) - 1)
        Case "В"
          Cells(i, "G") = Cells(i, "G") + Left(Matches.Item(j), Len(Matches.Item(j)) - 1)
        Case "Г"
          Cells(i, "H") = Cells(i, "H") + Left(Matches.Item(j), Len(Matches.Item(j)) - 1)
        Case "Д"
          Cells(i, "I") = Cells(i, "I") + Left(Matches.Item(j), Len(Matches.Item(j)) - 1)
        Case "Е"
          Cells(i, "J") = Cells(i, "J") + Left(Matches.Item(j), Len(Matches.Item(j)) - 1)
        Case "Ж"
          Cells(i, "K") = Cells(i, "K") + Left(Matches.Item(j), Len(Matches.Item(j)) - 1)
      End Select
    Next
  Next
End Sub
Изменено: Kuzmich - 3 мар 2021 19:07:47
Написал код макроса для ячейки B15, но он не работает, можете подсказать где у меня там ошибка
 
Цитата
чтобы он делал курсивом необходимую мне часть текста в исходной ячейки B15
Так сделайте курсивом шрифт в ячейке В1 листа2
Найти неопределенное множество строк между определенными значениями
 
Код
Sub FullAdres()
Dim FoundAdres As Range
Dim FAdr As Long
Dim EAdr As Long
Dim i As Long
     Columns(2).ClearContents
  With Worksheets("БАЗА")
    Set FoundAdres = .Columns(1).Find("Адрес организации", , xlValues, xlWhole)
      FAdr = FoundAdres.Row + 1
      EAdr = .Columns(1).Find("8", FoundAdres).Row - 1
      For i = FAdr To EAdr
        Range("B2") = Range("B2") & Chr(10) & .Cells(i, 1)
      Next
  End With
End Sub
При сцеплении форматировать фрагменты текста
 
Цитата
а в книге 12 , когда я меняю содержимое ячейки R1 листа 2
Как вы меняете значение, если у вас там формула
Код
='D:\Мои документы\Downloads\Введение отчетности Excel\[Реестр грузовых авианакладных.xlsx]Итоговая декада'!$O$13
Сортировка по числам, которые в конце строки после текста, Возможна ли сортировка по числам, которые идут в конце строки после текста?
 
UDF
Код
Function iкг(cell$)
 With CreateObject("VBScript.RegExp")
     .Global = True
     .Pattern = "\d+(?= кг)"
   If .test(cell) Then
     iкг = .Execute(cell)(0)
     iкг = Format(iкг, "000")
   Else
     iкг = ""
   End If
 End With
End Function

Потом сортируйте по этому столбцу
При сцеплении форматировать фрагменты текста
 
Для ячейки А20
1.1. Обязательство Субагента перед Агентом по перечислению выручки, полученной от реализации перевозок по договору №13 – САГ от « 28 » августа 20 20 года, составляет 3100 (три тысячи сто рублей 00 копеек), без НДС.
Я бы анализировал содержимое ячейки, например так для номера договора №13 – САГ
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 Dim re As Object
 Dim Matches As Object
 Range("A20") = Range("A20")
  Set re = CreateObject("VBScript.RegExp")
    re.Pattern = "№\d+[\sА-Я–]+"
    Set Matches = re.Execute(Range("A20"))
  With Range("A20").Characters(Matches(0).FirstIndex, Matches(0).Length).Font
     .Italic = True
     .Bold = True
     .Underline = True
  End With
End Sub
Поиск необходимого значение (города) по 2 и более условиям
 
Цитата
помочь мне с адаптацией формулы
Нет, к сожалению, я не формулист
Поиск необходимого значение (города) по 2 и более условиям
 
В модуль листа
Код
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, Range("F1:F2")) Is Nothing Then
Dim iLastRow As Long
Dim FoundContry As Range
Dim FAdr As String
Dim j As Integer
    Application.EnableEvents = False
   iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
If WorksheetFunction.CountIf(Range("A1:A" & iLastRow), Range("F1")) >= Range("F2") Then
  Set FoundContry = Columns("A").Find(Range("F1"), , xlValues, xlWhole)
  If Not FoundContry Is Nothing Then
     FAdr = FoundContry.Address
     j = 1
   Do
     If j = Range("F2") Then
       Range("H1") = FoundContry.Offset(, 2)
       Exit Do
     End If
      Set FoundContry = Columns("A").FindNext(FoundContry)
      j = j + 1
   Loop While FoundContry.Address <> FAdr
  End If
Else
  MsgBox "Количество стран в столбце А меньше чем в условии"
End If
 End If
    Application.EnableEvents = True
End Sub
Как перенести в VBA длинное число?
 
Добавить 1
Код
Function Plus1(cell As String)
   Plus1 = Left(cell, 10) & CDbl(Mid(cell, 11)) + 1
End Function
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 250 След.
Наверх