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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 192 След.
Удалить строку с жирным текстом, если следующая под ней пустая
 
Код
Sub Tablica()
Dim i As Long
Dim iLastRow As Long
 iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
  For i = iLastRow To 1 Step -1
    If Cells(i, 1).Font.Bold = True And IsEmpty(Cells(i + 1, 1)) Then
      Rows(i).Delete
    End If
  Next
End Sub
Удалить строку с жирным текстом, если следующая под ней пустая
 
Цитата
удалить эту жирную строку.
Так удалить или очистить, судя по примеру?
Оборотно-сальдовая ведомость. Обработка VBA
 
Цитата
когда номер счёта отсутствует внутри таблицы и там вопрос определения начала списка контрагентов
Приложите пример в формате Excel различных видов таблиц
Извлечение из текста числового фрагмента регулярными выражениями
 
Выделите F2 и протяните формулу на нужное количество строк
Извлечение из текста числового фрагмента регулярными выражениями
 
Цитата
а вот в строке номер 3 нифига
Посмотрите формулу во второй строке и сравните с формулой в третьей.
Удалить слова с определенным количеством букв
 
кузя1972, Если слово будет в начале текста, то оно не будет удалено.
Удалить слова с определенным количеством букв
 
Код
Sub Del_1_3_Letters()
Dim i As Long
Dim iLastRow As Long
Dim re As Object
 iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Set re = CreateObject("vbscript.regexp")
    re.Pattern = "^[А-ЯЁа-яё]{1,3} |\s[А-ЯЁа-яё]{1,3}(?=\s)"
    re.Global = True
  For i = 1 To iLastRow
    Cells(i, 2) = re.Replace(Cells(i, 1) & " ", "")
  Next
End Sub
удалить все кроме букв и пробелов
 
Цитата
удалить все кроме букв и пробелов
Для примера из сообщения #2
Код
Sub Tablica()
Dim i As Long
Dim iLastRow As Long
Dim re As Object
 iLastRow = Cells(Rows.Count, 2).End(xlUp).Row
    Set re = CreateObject("vbscript.regexp")
    re.Pattern = "[^ А-ЯЁа-яё]"
    re.Global = True
    re.IgnoreCase = True
  For i = 2 To iLastRow
    Cells(i, 3) = re.Replace(Cells(i, 2), "")
  Next
End Sub
Генератор фраз из заданного набора слов, Генератор фраз по столбцам
 
И здесь было подобное https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=104590
Поиск всех ячеек с заданным набором букв -> оставить в этих ячейках только цифры -> сложить эти цифры
 
Цитата
взять из них цифры и сложить
Сумма в ячейке В2
Код
Sub Summa_АБВ()
Dim i As Long
Dim iLastRow As Long
Dim iSumma As Double
 iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
    iSumma = 0
  For i = 1 To iLastRow
    If InStr(1, Cells(i, "A"), "АБВ") > 0 Then
      iSumma = iSumma + Split(Cells(i, "A"), "- ")(1)
    End If
  Next
    Range("B2") = iSumma
End Sub
Ключевые слова в одной ячейке и их фильтрация.
 
Цитата
поподробнее с макросом? Как его сделать?
В ячейке В1 делаете выпадающий список с вашими жанрами. При выборе определенного
жанра срабатывает макрос.
Код
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, Range("B1")) Is Nothing Then
      Application.EnableEvents = False
Dim i As Long
Dim iLastRow As Long
 If Target <> "все" Then
  Rows("2:10000").Hidden = False
  iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    For i = iLastRow To 3 Step -1
      If InStr(1, Cells(i, "B"), Target) = 0 Then
        Rows(i).Hidden = True
      End If
    Next
  Else
    Rows("2:10000").Hidden = False
  End If
 End If
      Application.EnableEvents = True
End Sub

Извлечение цифр с +
 
кузя1972, У вас в сообщении 9 и 11 код паттерна не совпадает с кодом в примере
Код
.Pattern = "^(?:8 |tel:  8 |\(?8)": txt = .Replace(t, "")
Извлечение цифр с +
 
кузя1972, а, если будет такой номер +7 921 345 67 89, посмотрите, что выдает ваш паттерн.
Извлечение цифр с +
 
кузя1972, 8 может быть не только в начале номера.
И при таком шаблоне будут убраны все восьмерки в номере.
Выборка номеров строк ячеек по условию и запись их в отдельный столбец
 
Цитата
надо выбирать номера строк "ВСЕГО"
Код
Sub iВсего()
Dim i As Long
Dim iLastRow As Long
Dim FoundCell As Range
Dim FAdr As String
 With Worksheets("Лист2")
    .Cells.Clear
    .Cells(1, 1) = "Номера строк со словом Всего"
    Set FoundCell = Columns(1).Find("Всего", , xlValues, xlWhole)
     If Not FoundCell Is Nothing Then
      FAdr = FoundCell.Address
      Do
        iLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        .Cells(iLastRow, 1) = FoundCell.Row
       Set FoundCell = Columns(1).FindNext(FoundCell)
      Loop While FoundCell.Address <> FAdr
     End If
 End With
End Sub
Разбить несколько таблиц расположенных вертикально по горизонтали
 
Цитата
так как таблица из которой нужно выдернуть данные очень большая порядка 50 тысяч строк
А столбцов то вам хватит?
Подсчет суммы значений после пустой строки
 
Цитата
чтобы в эту пустую строчку суммировались вышестоящие значения количества, веса и объема, при этом выделив итог жирным и покрасив в желтый цвет
Код
Sub iSumma()
Dim Rng As Range
Dim j As Integer
For j = 2 To 4
  For Each Rng In Columns(j).SpecialCells(xlCellTypeConstants).Areas
    Rng.Cells(Rng.Count + 1, 1).Value = WorksheetFunction.Sum(Rng)
    Rng.Cells(Rng.Count + 1, 1).Font.Bold = True
    Rng.Cells(Rng.Count + 1, 1).Interior.ColorIndex = 6
  Next
Next
End Sub
Вывод адреса ячейки с дублем
 
Вывод в столбец D
Код
Sub Poisk()
Dim i As Long
Dim iLastRow As Long
Dim FoundCell As Range
 iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
  For i = 2 To iLastRow
    Set FoundCell = Columns(2).Find(Cells(i, "A"), , xlValues, xlWhole)
    If Not FoundCell Is Nothing Then
      Cells(i, "D") = Cells(i, "A").Address(0, 0) & "=" & Cells(FoundCell.Row, "B").Address(0, 0)
    Else
      Cells(i, "D") = Cells(i, "A").Address(0, 0)
    End If
  Next
End Sub
Вывод адреса ячейки с дублем
 
Цитата
В каждом из столбцов встречаются одинаковые значения (дубли)
Встречаются 1 раз?
Сумма по группам и подгруппам
 
Цитата
По форуму искал, видел подобные темы
А это смотрели
https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=84724
https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=98418
Поиск по объединенным ячейкам
 
Цитата
как корректно осуществить поиск и постановку данных (макросом) с учетом объединенных ячеек.
При активном лист1 запустить макрос
Код
Sub Poisk()
Dim i As Long
Dim iLastRow As Long
Dim FoundPozition As Range
Dim Region As Range
Dim Postavchik As Range
With Worksheets("Лист2")
 iLastRow = Cells(Rows.Count, "D").End(xlUp).Row
  For i = 6 To iLastRow
   Set Region = .Rows(6).Find(Range("A1"), , xlValues, xlWhole)
   Set Postavchik = .Range(.Cells(7, Region.Column), .Cells(7, Region.Column + 3)).Find(Range("A2"), , xlValues, xlWhole)
    Set FoundPozition = .Columns("E").Find(Cells(i, "D"), , xlValues, xlWhole)
    If Not FoundPozition Is Nothing Then
      Cells(i, "F") = .Cells(FoundPozition.Row, Postavchik.Column)
    End If
  Next
End With
End Sub
После определенного слова скопировать текст (цифры)
 
Цитата
полный код можно?
UDF
Код
'Бэн Форта 
Function iIP(cell$)
 With CreateObject("VBScript.RegExp")
     .Global = True
     .IgnoreCase = True
     .Pattern = "(((\d{1,2})|(1\d{2})|(2[0-4]\d)|(25[0-5]))\.){3}((1\d{2})|(2[0-4]\d)|(25[0-5]))"
     iIP = .Execute(cell)(0)
 End With
End Function
После определенного слова скопировать текст (цифры)
 
Казанский, Алексей, я не знаю точно, как формируется IP адрес по правилам, только знаю,что каждая составляющая не должна быть больше 255.
А формула  возьмет все неправиьные адреса, типа 999.999.999.999
После определенного слова скопировать текст (цифры)
 
Бен Форта в книге о регулярках  приводил шаблон для поиска IP адресов, так вот адрес 185.53.100.2 не находит
Код
.Pattern = "(((\d{1,2})|(1\d{2})|(2[0-4]\d)|(25[0-5]))\.){3}((1\d{2})|(2[0-4]\d)|(25[0-5]))"
После определенного слова скопировать текст (цифры)
 
Цитата
нужно выписать все ip адреса из всего текста после "remote_" и заканчивая пробелом
А вы уверены, что 185.53.100.2 является правильным IP адресом?
Замена отдельных слов с регулярными выражениями, "{\b(ИП|ООО|ЗАО|Торговая Компания)\b}"
 
На русском
https://docs.microsoft.com/ru-ru/previous-versions/visualstudio/visual-studio-2008/28hw3sce%28v%3dvs...
Добавление строк по заданному в ячейке кол-ву, Макрос добавления строк по значению в ячейке.
 
Цитата
добавлялось конкретное кол-во строк по значению в А1
При активном Лист1 запустить
Код
Sub iInsertRows()
  With Worksheets("Лист2")
    .Rows(2).Resize(Range("A1")).Insert
  End With
End Sub
Проверка на целое число с условием
 
А так попробуйте
Код
=ЕСЛИ(ОСТАТ(ОКРУГЛВВЕРХ(F5/B19;0);2)=0;ОКРУГЛВВЕРХ(F5/B19;0);ОКРУГЛВВЕРХ(F5/B19;0)+1)
Сортировка чисел в текстовой строке по убыванию. Числа находятся внутри слов.
 
Цитата
Как макросом - отсортировать этот текст с числами ?
Код
Sub iSortDigit()
Dim mo As Object
Dim n As Integer
Dim i As Long
 With CreateObject("VBScript.RegExp")
   .Global = True
   .IgnoreCase = True
   .MultiLine = True
   .Pattern = "[а-я]+(\d)[а-я]+"
     If .test(Cells(16, 5)) Then
       Set mo = .Execute(Cells(16, 5))
         For n = 0 To mo.Count - 1
           Cells(16 + n, 10) = mo(n).SubMatches(0)
           Cells(16 + n, 11) = mo(n)
         Next
         Range(Cells(16, 10), Cells(16 + n - 1, 11)).Sort Key1:=Cells(16, 10), _
                                                Order1:=xlDescending, Header:=xlNo
         Range("E22") = Join(Application.Transpose(Range(Cells(16, 11), Cells(16 + n - 1, 11))), "+")
         Range(Cells(16, 10), Cells(16 + n - 1, 11)).ClearContents
    End If
 End With
End Sub
Изменено: Kuzmich - 13 Май 2018 13:55:45
[ Закрыто] Проблема с макросом Excel 2003
 
Цитата
Помогите наладить работу макроса на 2003, работу на старших версиях не предлагать.
Почему тогда пример не в формате xls ?
В 2003 65 тыс строк
Код
Range("B10:C100000").Select
Изменено: Kuzmich - 12 Май 2018 22:33:32
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 192 След.