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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 263 След.
Нужно разделить варианты ответов символом |
 
Цитата
после запятой пробел и Заглавная буква
Код
Sub Tablica()
Dim i As Long
Dim iLastRow As Long
Dim Delimiter As String
   Delimiter = "|"
 iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
 With CreateObject("VBScript.RegExp")
     .Global = True
     .Pattern = ",\s(?=[А-Я])"
   For i = 1 To iLastRow
     If .test(Cells(i, 1)) Then
       Cells(i, 2) = .Replace(Cells(i, 1), Delimiter)
     End If
   Next
 End With
End Sub
Функция в VBA не работает под старым Excel
 
В Excel 2003 есть библиотека Microsoft XML, v6.0
Заполнение датами колонки в таблице данными из другой по нескольким значениям
 
Цитата
как это реализовать макросом
В модуль книги Картотека...
Код
Sub LastDate_()
Dim i As Long
Dim iLastRow As Long
Dim FoundInnos As Range
Dim FAdr As String
 iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
  With Workbooks("Журнал КДС.xls").Worksheets("Лист1")
    For i = 2 To iLastRow
     If Cells(i, "D").Interior.ColorIndex = -4142 Then          'нет заливки
      Set FoundInnos = .Columns("H").Find(Cells(i, "D"), , xlValues, xlWhole, xlByRows, xlPrevious)
      If Not FoundInnos Is Nothing Then
        FAdr = FoundInnos.Address
        Do
         If FoundInnos.Offset(, -2) = "положена" Or FoundInnos.Offset(, -2) = "посылка" Then
           Cells(i, "E") = FoundInnos.Offset(, -7)
           Exit Sub
         End If
          Set FoundInnos = .Columns("H").Find(Cells(i, "D"), FoundInnos, xlValues, xlWhole, xlByRows, xlPrevious)
        Loop While FoundInnos.Address <> FAdr
      End If
     End If
    Next
  End With
End Sub

Обе книги должны быть открыты
Пропарсить фото и изьять оттуда данные
 
Открыл рисунок в PDF to Excel Converter_PDF-Transformer-12.0.104.225-key
Преобразовал в файл Excel
Изучения VBA для начинающих, Нужны толковые учебники по VBA (макросам), для начинающих
 
На этом сайте вверху есть меню ССЫЛКИ выбираете сайт Первые шаги. Успехов!
Суммирование данных из разных столбцов, учитывая вхождение столбца по соответсвию критерию.
 
В модуль листа1, срабатывает при изменении месяца в С15. В ячейке сделать выпадающий список из месяцев
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("C15")) Is Nothing Then
        Application.EnableEvents = False
Dim iMonth As String
Dim FoundMonth As Range
Dim j As Integer
Dim iSumma As Double
        iMonth = Target.Text
        Range("C17") = 0
      Set FoundMonth = Rows(3).Find(iMonth, , xlValues, xlWhole)
      For j = 3 To FoundMonth.Column
        If Not Cells(3, j) Like "*квартал" Then
          iSumma = iSumma + Cells(4, j)
        End If
      Next
      Range("C17") = iSumma                  'для наименования 1
      Range("C17").NumberFormat = "#,##0"
    End If
    Application.EnableEvents = True
End Sub

Для других строк доделайте сами
Выделение жирным шрифтом только цифры в столбце
 
Код
Sub BoldDigit()
Dim i As Long
Dim iLastRow As Long
Dim j As Integer
 iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
 Range("A1:A" & iLastRow).Font.Bold = False
For i = 1 To iLastRow
  For j = 1 To Len(Cells(i, "A"))
    If Mid(Cells(i, "A"), j, 1) Like "[0-9]" Then
      Cells(i, "A").Characters(j, 1).Font.Bold = True
    End If
  Next
Next
End Sub
RegExp. Шаблон "\b[A-ZА-ЯЁ][a-zа-яё]+\b" работает с латинским текстом, а на кириллицу не действует.
 
В теме https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=119086&TITLE_SEO=119086-kak-iz-teksta-pri-poluchenii-russkogo-slova-isklyuchit-slova-soderzhashch&logout_butt=%D0%92%D1%8B%D0%B9%D1%82%D0%B8
ZVI предлагал трюк для работы с \b с русскими буквами, но я так и не осилил. Может вам удастся. Удачи
Заполнение датами колонки в таблице данными из другой по нескольким значениям
 
Цитата
Всё поправил.
А сообщить о кроссе
http://www.excelworld.ru/forum/10-48376-1
Найти значение из столбца А, соответствующее наибольшей разнице двух других столбцов
 
Код
Sub PoiskMax()
Dim i As Long
Dim iLastRow As Long
  iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
  Range("G1") = Cells(1, "C") - Cells(1, "B")
  Range("F1") = Cells(1, "A")
 For i = 2 To iLastRow
   If Cells(i, "C") - Cells(i, "B") > Range("G1") Then
     Range("G1") = Cells(i, "C") - Cells(i, "B")
     Range("F1") = Cells(i, "A")
   End If
 Next
End Sub
Выбор данных за определенную дату с листов книги
 
Цитата
подскажите как это осуществить
В модуль листа2
Код
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("D5")) Is Nothing Then
    Application.EnableEvents = False
Dim FoundDate As Range
Dim Sh As Worksheet
Dim i As Long
Dim iLastRow As Long
Dim iLR As Long
 iLastRow = Cells(Rows.Count, "D").End(xlUp).Row + 1
 Range("D10:F" & iLastRow).ClearContents
  For Each Sh In Worksheets
    If Sh.Name <> "Лист2" Then
     With Sh
       Set FoundDate = .Rows(7).Find(Target, , xlFormulas, xlWhole)
       If Not FoundDate Is Nothing Then     'нашли соответствие
          iLR = .Range("B7").End(xlDown).Row
          For i = 8 To iLR
            If Not IsEmpty(.Cells(i, FoundDate.Column)) Then
             iLastRow = Cells(Rows.Count, "D").End(xlUp).Row + 1
             Cells(iLastRow, "D") = Sh.Name                                'имя листа
             .Cells(i, "B").Copy Cells(iLastRow, "E")                      'наименование
             .Cells(i, FoundDate.Column).Copy Cells(iLastRow, "F")         'количество
            End If
          Next
       End If
     End With
    End If
  Next
  End If
    Application.EnableEvents = True
End Sub

Макрос срабатывает при изменении даты в D5
Разделение таблицы на файлы по ID
 
https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=101216
Найти ближайший день рождения
 
Цитата
находить ближайший к сегодня день рождения и выводить всех людей у кого д.р.
На Лист1 кнопка "Ближайшие на 30 дней ДР"
Выцепить часть текста, идущую после последнего двоеточия
 
UDF
Код
Function PartText(cell As String) As String
  PartText = Mid(cell, InStrRev(cell, ":") + 1)
End Function
Запись с указанием текущего времени
 
Цитата
должен по идеи был копировать в последующую пустую строку столбца А,
А вы ищете последнюю строку по столбцу В
Исправьте на
Код
nextRow = Лист2.Cells(Лист2.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Протянуть формулу по столбцу во вновь добавленную строку VBA
 
Цитата
Далее нужно во вновь добавленную строку растащить формулы из верхней строки по всем столбцам (10 столбцов)
Код
Sub InsertRowsFormula()
Dim j As Integer
ActiveCell.Offset(1, 0).EntireRow.Insert
  For j = 1 To 10
    If Cells(ActiveCell.Row, j).HasFormula Then
       Cells(ActiveCell.Row + 1, j).FillDown
    End If
  Next
End Sub
Сцепить значения из динамического диапазона (меняется количество строк)
 
Евгений Минаков, написал
Цитата
Разобрался! Спасибо, JayBhagavan!  
А ответ на соседнем форуме вам не подошел?
Кросс http://www.excelworld.ru/forum/10-48332-1
Макрос скрытия строк. Ошибка при запуске
 
New, написал
Цитата
У вас же не 97 Excel
У меня Excel 2003, а в коде ТС стояло КоличествоСтрок%
поэтому и As Integer
Макрос скрытия строк. Ошибка при запуске
 
Код
Private Sub CommandButton_HideRows_Click()
Dim txt As String
Dim КоличествоСтрок As Integer
    txt = WorksheetFunction.Trim(Me.TextBox_SearchText): If Len(txt) = 0 Then Exit Sub    ' если текст не введён
    КоличествоСтрок = ПоискСтрокПоУсловию(txt, True)
    If КоличествоСтрок > 0 Then

и далее по коду
Как вычислить количество определенного слова в разных ячейках
 
Цитата
посчитать сколько какая страна раз упоминается.
Код
Sub KolUniqCountry()
Dim arr
Dim dic As Object
Dim i As Long
Dim iLastRow As Long
    iLastRow = Cells(Rows.Count, "B").End(xlUp).Row
     Range("E1:F" & iLastRow).ClearContents
     Set dic = CreateObject("Scripting.Dictionary"): dic.comparemode = 1
     arr = Range("B2:B" & iLastRow).Value
  For i = 1 To UBound(arr)
    dic.Item(arr(i, 1)) = dic.Item(arr(i, 1)) + 1
  Next i
   Range("E2").Resize(dic.Count, 2) = Application.Transpose(Array(dic.keys, dic.Items))
End Sub
Поиск ключевых слов в тексте с подстановкой определенных значений
 
Код
Sub iPoiskReplace()
Dim i As Long
Dim iLastRow As Long
Dim FoundCell As Range
Dim arr
Dim j As Integer
    iLastRow = Cells(Rows.Count, "F").End(xlUp).Row
    Range("G2:G" & iLastRow).ClearContents
    Range("G2:G" & iLastRow).NumberFormat = "@"
  For i = 2 To iLastRow
    arr = Split(WorksheetFunction.Trim(Cells(i, "F")), " ")
    For j = 0 To UBound(arr)
      Set FoundCell = Columns("A:D").Find(arr(j), , xlValues, xlPart)
      If Not FoundCell Is Nothing Then
        Cells(i, "G") = Cells(i, "G") & Cells(1, FoundCell.Column) & " "
      Else
        Cells(i, "G") = Cells(i, "G") & arr(j) & " "
      End If
    Next
  Next
End Sub
Добавление строки по условию в таблицу c помощью VBA
 
вопрос к Mershik, его макрос
Автоматический запуск макроса при изменении данных
 
Аркадий Бочкарев, написал
Цитата
Скрывает строки если ячейки пустые
а в коде
Код
If Not IsEmpty(c) Then

это, если ячейка не пустая. Так, что вы проверяете?
Поиск соответствия всех значений, используя столбец, содержащий дубликаты.
 
Excelman,
Цитата
чтоб работало и на 2003 - можно чем то заменить СЧЁТЕСЛИМН?
Изучайте https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=111226
Поиск соответствия всех значений, используя столбец, содержащий дубликаты.
 
Find и  FindNext
Как посчитать количество (в т.ч. диапазон) целых чисел в одной ячейке разделенных запятой?
 
Мне даже страшно смотреть на такие формулы  8-0
Попробуйте макросом
Код
Sub iSummaKol()
Dim arr
Dim iSummaKol As Long
Dim cell As Range
Dim i As Integer
    iSummaKol = 0
  For Each cell In Range("B1:E2")
    If Not IsEmpty(cell) Then
        arr = Split(cell, ",")
        For i = 0 To UBound(arr)
          If InStr(1, arr(i), "-") > 0 Then
              iSummaKol = iSummaKol + Split(arr(i), "-")(1) - Split(arr(i), "-")(0) + 1
          Else
              iSummaKol = iSummaKol + 1
          End If
        Next
    End If
  Next
    Range("A1") = iSummaKol
End Sub
Принятнуть значения сразу по нескольким аргументам
 
na-ers,
Скажите, по какой необходимости порядок Овощи, фрукты, макароны на листах разный?
Как посчитать количество (в т.ч. диапазон) целых чисел в одной ячейке разделенных запятой?
 
Андрей Алексеевич,
Цитата
в файле только один пример, но у меня таких ячеек 8+1(итог) много
Приведите реальный пример.
Да и формулы я не писал.
Как посчитать количество (в т.ч. диапазон) целых чисел в одной ячейке разделенных запятой?
 
БМВ,
Я сам же добавил в первую ячейку 1-15,20 и забыл. Склероз
Как посчитать количество (в т.ч. диапазон) целых чисел в одной ячейке разделенных запятой?
 
Цитата
в т.ч. диапазон
А у меня в вашем примере получилось 25
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 263 След.
Наверх