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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 246 След.
Вывести последнее число в строке, просмотрев нужные столбцы
 
А где в акте указан номер квартиры?
Акт за декабрь, а показания за январь-февраль.
Открыть с помощью кнопки определенный скрытый лист
 
В модуль листа
Код
Private Sub Worksheet_Deactivate()
   Worksheets("Лист3").Visible = False
End Sub
Вывести последнее число в строке, просмотрев нужные столбцы
 
Цитата
чтобы в шаблоне акта отражались
Приведите пример шаблона. Лист1 - это ваша база данных.
Открыть с помощью кнопки определенный скрытый лист
 
Привяжите к своей кнопке
Код
Sub iHiddenSheet()
  Worksheets("" & Range("G4") & "").Visible = True
End Sub
[ Закрыто] Извлечь из текста наименование улицы
 
А чем эта тема отличается от https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=136412
Выделение цветом ячейки при поиске
 
Екатерина Журавель, написала
Цитата
Я под конец фильтрую все выделенные цветом ячейки и отправляю с реестром на головной офис.
А что мешает сразу переносить найденные строки с номером накладной на Лист2 и тем самым формировать реестр для отсылки
Выделение цветом ячейки при поиске
 
Код
Sub FindNomer()
Dim cell As Range
Dim Nomer As Long
   Nomer = Application.InputBox("Введите номер", Type:=1)
     Set cell = Columns(2).Find(Nomer, , xlValues, xlWhole)
        If Not cell Is Nothing Then
          cell.Interior.ColorIndex = 6
        Else
          MsgBox "В столбце В нет номера: " & Nomer
        End If
End Sub
Подставить текст к выбранному значению из списка.
 
Цитата
я выбираю данные из раскрывающего списка
А где этот список?
Ошибка при добавлении новой записи: application defined or object defined error
 
Правила  позволяют до 300 Кб
2.3. Приложите файл(ы) с примером (общим весом не более 300Кб)
EXCEL 2003. Суммировать диапазон ячеек по двум критериям:
 
А где пример ?
И посмотрите здесь https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=111226
Изменено: Kuzmich - 20 янв 2021 11:53:54
EXCEL 2003. Суммировать диапазон ячеек по двум критериям:
 
Код
как можно реализовать функцию суммеслимн в Excel 2003

Приведите пример ваших данных и опишите задачу, возможно вам надо будет применить
функцию WorksheetFunction.SumIf
Поиск соответствующего значения в неструктурированном массиве
 
Цитата
любым идеям по реализации
Код
Sub tt()
Dim i As Long
Dim iLastRow As Long
Dim FoundK As Range
  iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
  For i = 43 To iLastRow
    Set FoundK = Range("A3:N38").Find(Cells(i, "A"), , xlValues, xlWhole)
      Cells(i, "B") = FoundK.Offset(-2)
  Next
End Sub
Форматирование по правилу: наличие верхней и нижней границ
 
Ranker Dark,
А чем мое решение не подошло?
Копируйте код нормально и будет вам счастье.
Форматирование по правилу: наличие верхней и нижней границ
 
Код
Sub iBorders()
Dim rng As Range
  For Each rng In Range("D4:J4")
    If rng.Borders(xlEdgeTop).LineStyle = xlContinuous And rng.Borders(xlEdgeBottom).LineStyle = xlContinuous Then
      rng.Interior.ColorIndex = 8
    End If
  Next
End Sub
Макрос для поиска и подсветки ячеек в таблице из заданного диапазона (состоящего из нескольких составляющих)
 
Цитата
макрос для поиска и подсветки ячеек в таблице, например, (жёлтым цветом)
Код
Sub iArticle()
Dim iLastRow As Long
Dim i As Long
Dim Article As String
Dim FoundArticle As Range
Dim FirstAdres As String
Dim j As Integer
  iLastRow = Cells(Rows.Count, "G").End(xlUp).Row
  Range("G4:H" & iLastRow).Interior.ColorIndex = xlNone
'  iLastRow = Cells(Rows.Count, "J").End(xlUp).Row
  For i = 3 To 7
    Article = Cells(i, "J")
Set FoundArticle = Columns(7).Find(Article, , xlValues, xlWhole)
    If Not FoundArticle Is Nothing Then     'нашли
        FirstAdres = FoundArticle.Address   'адрес первого вхождения
        Do
          For j = 11 To 14
            If FoundArticle.Offset(, 1) = CStr(Cells(i, j)) Then
              FoundArticle.Resize(, 2).Interior.ColorIndex = 6
              Exit For
            End If
          Next
            Set FoundArticle = Columns(7).FindNext(FoundArticle)
        Loop While FoundArticle.Address <> FirstAdres
    End If
  Next
End Sub
Выделение изменяемого диапазона заполненніх ячеек
 
Код
Range("F5").CurrentRegion.Select
форматирование по правилу: в ячейке сверху должет быть текст и он не должен содержать определенного слова.
 
Цитата
Нужно произвести форматирование ячеек, которые удовлетворяют особому правилу:
Код
Sub Schar()
Dim rng As Range
  For Each rng In Range("D4:K5")
    If WorksheetFunction.IsText(rng) And Not rng = "Шар" Then
      rng.Offset(1).Borders(xlEdgeLeft).Weight = xlThin
    End If
  Next
End Sub
Как получить название улицы из текста, содержащего адрес?
 
Цитата
минус всего это в колонки разное положение наименование улицы
UDF
Код
Function iStreet(cell$)
 With CreateObject("VBScript.RegExp")
     .IgnoreCase = True
     .Pattern = "(ул\.|улица|пр\.)\s([^,]+)"
     If .test(cell) Then
       iStreet = .Execute(cell)(0).SubMatches(1)
     Else
       .Pattern = "([^,]+)(?=ул\.|тракт|пр\.)"
       iStreet = .Execute(cell)(0)
     End If
 End With
End Function
Заполнение таблицы данными с заведомо известным максимальным количеством строк
 
ГДВ,
Попробуйте такой вариант
Код
Sub Tablica()
Dim i As Long
Dim j As Integer
Dim n As Integer
Dim iLastRow As Long
Dim iCol As Integer              'количество необходимых столбцов
Dim k As Integer                 'кол-во столбцов с Range("P6")
Dim iLR As Long
Dim iLastCol As Integer
  iLR = Cells(Rows.Count, "A").End(xlUp).Row
  iLastCol = Cells(4, Columns.Count).End(xlToLeft).Column
    Range(Cells(4, 1), Cells(iLR, iLastCol)).ClearContents
  iLastRow = Cells(Rows.Count, "O").End(xlUp).Row
  iCol = WorksheetFunction.RoundUp((iLastRow - 5) / Range("P6"), 0)
  If iCol >= 15 Then MsgBox "При таком количестве строк данные будут затерты": Exit Sub
   For n = Range("P6") - 1 To 1 Step -1
      k = 0
    Do
      k = k + 1
    Loop While k * Range("P6") + (iCol - k) * n <> iLastRow - 5 And k < iCol
      If k * Range("P6") + (iCol - k) * n = iLastRow - 5 Then Exit For
   Next
    j = 1
  For i = 6 To k * Range("P6") + 5 Step Range("P6")
    Range(Cells(i, "O"), Cells(i + Range("P6") - 1, "O")).Copy Cells(4, j)
    j = j + 1
  Next
  For i = k * Range("P6") + 6 To iLastRow Step n
    Range(Cells(i, "O"), Cells(i + n - 1, "O")).Copy Cells(4, j)
    j = j + 1
  Next
End Sub
Заполнение таблицы данными с заведомо известным максимальным количеством строк
 
В первом приближении макрос
Код
Sub Tablica()
Dim i As Long
Dim j As Integer
Dim iLastRow As Long
Dim iCol As Integer              'количество необходимых столбцов
Dim k As Integer                 'кол-во столбцов с Range("P6")
  iLastRow = Cells(Rows.Count, "O").End(xlUp).Row
  iCol = WorksheetFunction.RoundUp((iLastRow - 5) / Range("P6"), 0)
  Range(Cells(4, 1), Cells(3 + Range("P6"), iCol)).ClearContents
    k = 0
  Do
    k = k + 1
  Loop While k * Range("P6") + (iCol - k) * (Range("P6") - 1) <> iLastRow - 5 Or k > iCol - 1
    j = 1
  For i = 6 To k * Range("P6") + 5 Step Range("P6")
    Range(Cells(i, "O"), Cells(i + Range("P6") - 1, "O")).Copy Cells(4, j)
    j = j + 1
  Next
  For i = k * Range("P6") + 6 To iLastRow - 5 Step Range("P6") - 1
    Range(Cells(i, "O"), Cells(i + Range("P6") - 2, "O")).Copy Cells(4, j)
    j = j + 1
  Next
End Sub
Подтянуть количество значений (груп товаров по регионам) из другого листа
 
При активном листе Report2 запустить макрос
Код
Sub GroupNapravlenie()
Dim iLastRow As Long
Dim Found_N As Range
Dim FAdr As String
 Application.ScreenUpdating = False
 With Worksheets("Report1")
  iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Range("B2:M" & iLastRow).ClearContents
  For i = 2 To iLastRow
   Set Found_N = .Columns("I").Find(Cells(i, "A"), , xlValues, xlWhole)
    If Not Found_N Is Nothing Then
      FAdr = Found_N.Address
      Do
        Select Case Found_N.Offset(, -7)
         Case "1"
           Cells(i, "B") = Cells(i, "B") + 1
         Case "3"
           Cells(i, "C") = Cells(i, "C") + 1
         Case "11"
           Cells(i, "D") = Cells(i, "D") + 1
         Case "12"
           Cells(i, "E") = Cells(i, "E") + 1
         Case "15"
           Cells(i, "F") = Cells(i, "F") + 1
         Case "18"
           Cells(i, "G") = Cells(i, "G") + 1
         Case "20"
           Cells(i, "H") = Cells(i, "H") + 1
         Case "26"
           Cells(i, "I") = Cells(i, "I") + 1
         Case "29"
           Cells(i, "J") = Cells(i, "J") + 1
         Case "30"
           Cells(i, "K") = Cells(i, "K") + 1
         Case "31"
           Cells(i, "L") = Cells(i, "L") + 1
         Case "37"
           Cells(i, "M") = Cells(i, "M") + 1
        End Select
          Set Found_N = .Columns("I").FindNext(Found_N)
      Loop While Found_N.Address <> FAdr
    End If
  Next
 End With
 Application.ScreenUpdating = True
End Sub
Как сделать цикличное копирование макросом данных в отдельный лист по условию
 
Кросс http://www.excelworld.ru/forum/10-46682-1
И примера так и нет.
Выгрузка на отдельном листе объем данных за нужную дату
 
Поставить автофильтр и выгрузить видимые
Развернуть файл из Вертикального в горизонтальный
 
Цитата
Может еще кто сможет помочь?
А мой вариант не подошел?
Удаление всех строк между двумя значениями в столбце
 
Список удаляемых номеров на Листе3
Макрос запускать при активном Лист1
Код
Sub PoiskTelefonAndDeleteRows()
Dim Found_N As Range
Dim i As Long
Dim iLR As Long
Dim Found_Itogo As Range
With Worksheets("Лист3")
 iLR = .Cells(.Rows.Count, "A").End(xlUp).Row
  For i = 1 To iLR
   Set Found_N = Columns("B").Find(.Cells(i, "A"), , xlValues, xlWhole)
    If Not Found_N Is Nothing Then
        Set Found_Itogo = Cells(Found_N.Row, "A").End(xlDown)
        Rows(Found_N.Row & ":" & Found_Itogo.Row).Delete
    End If
  Next
End With
End Sub
Удаление всех строк между двумя значениями в столбце
 
Цитата
на третьем листе в столбце А
Сделайте список номеров, а затем цикл по этим номерам
Удаление всех строк между двумя значениями в столбце
 
Цитата
что от меня требуется?
Номеров, как вы написали, будет порядка 1000. Где они будут прописаны?
Для одного номера
Код
Sub PoiskTelefon()
Dim Found_N As Range
Dim Found_Itogo As Range
Dim FAdr As String
  Set Found_N = Columns("B").Find("375291112233", , xlValues, xlWhole)
    If Not Found_N Is Nothing Then
        Set Found_Itogo = Cells(Found_N.Row, "A").End(xlDown)
        Rows(Found_N.Row & ":" & Found_Itogo.Row).Delete
    End If
End Sub
Изменено: Kuzmich - 12 янв 2021 15:31:58
Удаление всех строк между двумя значениями в столбце
 
Цитата
Есть массив номеров, нужно проверить каждый и удалить все строки между совпавшим номером телефона и фразой.
Номер один раз встречается в столбце В?
Цитата
Номеров порядка 1000, в случае необходимости могу внести их руками в массив.
Внесите несколько, как пример
Изменено: Kuzmich - 12 янв 2021 15:15:51
Удалить все символы и буквы до И.О.Фамилия, Удалить все символы и буквы до И.О.Фамилия, если количество символов меняется
 
Цитата
оставалось только И.О.Фамилия
UDF
Код
Function iFIO(cell As String) As String
 With CreateObject("VBScript.RegExp")
     .Global = True
     .Pattern = "[А-ЯЁ]\.[А-ЯЁ]\. [А-ЯЁ][а-яё]+"
     If .test(cell) Then
       iFIO = .Execute(cell)(0)
     End If
 End With
End Function
Посчитать объем детали (размеры записаны в тексте)
 
UDF
Код
Function iVolume(cell$)
 With CreateObject("VBScript.RegExp")
   .Global = True
   .IgnoreCase = True
   .Pattern = "(\d+)н?-(\d+)н?-(\d+)"
    If .test(cell) Then
     iVolume = .Execute(cell)(0).SubMatches(0) * .Execute(cell)(0).SubMatches(1) * _
               .Execute(cell)(0).SubMatches(2) * 30 / 10000
     .Pattern = "\d+(?=\s?шт)"
     If .test(cell) Then
       iVolume = iVolume * .Execute(cell)(0)
     End If
    End If
 End With
End Function
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 246 След.
Наверх