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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 217 След.
Макрос изменения формата данных в ячейке
 
Код
Sub Макрос1()
    For Each cell In Range("B2:B6")
      If Len(cell) = 5 Then
       cell.Offset(, 1) = cell
       cell.Offset(, 1).NumberFormat = "#-##-##"
      ElseIf Len(cell) = 10 Then
       cell.Offset(, 1) = cell
       cell.Offset(, 1).NumberFormat = "+7(###)###-##-##"
      End If
    Next
End Sub
Выгрузка данных из Excel в несколько txt-файлов.
 
jeka-irbis,
Я в теме "Проверка и формирование уникальных значений ячеек столбца таблицы" добавил
вариант с формулой, вы видели?
Разбить столбец на несколько при разных разделителях
 
ЛегкийГолод,
Заполните полностью столбец В на листе "список городов"
Как правильно поместить данные в массив?, ошибка "Требуется объект". Как можно исправить?
 
Код
Sub Zadacha_2()
Application.ScreenUpdating = False 'инструкция для отключения обновления экрана во время отработки кода (д/быстродействия)
Dim arrTable As Variant 'переменная variant для таблицы-массива
  arrTable = Worksheets("Решение").Range("A1:C10") 'где находится массив, обозначение его границ
  Sheets.Add After:=Sheets("Решение") 'создать новый лист после листа "Решение"
  ActiveSheet.Range("A1").Resize(UBound(arrTable), UBound(arrTable, 2)) = arrTable
  ActiveSheet.Name = "1" 'присвоить листу имя "1"
Application.ScreenUpdating = True 'д/включения обновления экрана
End Sub
Разбить столбец на несколько при разных разделителях
 
ЛегкийГолод,
Если вы сделали на листе Список городов столбец с заменой, то попробуйте макрос
Код
Sub Tablica()
Dim iLastRow As Long
Dim n As Long
Dim iLR As Long
Application.ScreenUpdating = False
  iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
 With Worksheets("список_городов")
  iLR = .Cells(.Rows.Count, 1).End(xlUp).Row
     For n = 2 To iLR
      If InStr(1, .Cells(n, 1), "-") <> 0 Then
       Range("A2:A" & iLastRow).Replace what:=.Cells(n, 1), replacement:=.Cells(n, 2)
      End If
     Next
    Range("A2:A" & iLastRow).TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="-", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
        1), Array(6, 1), Array(7, 1)), TrailingMinusNumbers:=True
     For n = 2 To iLR
       If InStr(1, .Cells(n, 2), "_") <> 0 Then
          Range("A2:G" & iLastRow).Replace what:=.Cells(n, 2), replacement:=.Cells(n, 1)
       End If
     Next
 End With
Application.ScreenUpdating = True
End Sub
Разбить столбец на несколько при разных разделителях
 
Я думаю надо в списке городов сделать второй столбец, где заменить знак - на знак подчеркивания _
Затем на листе Отчет произвести замену городов с - на города с _
Затем текст по столбцам и обратную замену
Разбить столбец на несколько при разных разделителях
 
Михаил Витальевич С.,
А как быть с Санкт-Петербург и другими аналогичными городами?
Сортировка внутри таблицы без разбивки объединения
 
outsider_cmp,
Видимо в макросе надо исключить лист Основа из цикла обработки
Выполнить фильтрацию записей с помощью расширенного фильтра
 
denDELOVOI,
Ищете книгу Применение VBA и Макросов_в_Microsoft_Excel_Билл_Джелен_2006г , ну или более позние издания
Там изучаете главу 11 Анализ данных с помощью расширенного фильтра
Разбивка многострочных ячеек на строки
 
MMAXX95,
На Лист1 удалите строки с Образец и ниже
Код
Sub RazdelitStroki()
Dim i As Long
Dim iLastRow As Long
Dim n As Long
Dim arr_M
Dim arr_O
Dim arr_P
Dim arr_Q
    iLastRow = Cells(Rows.Count, "M").End(xlUp).Row
    For i = iLastRow To 2 Step -1
      If InStr(1, Cells(i, "M"), Chr(10)) > 0 Then
        arr_M = Split(Cells(i, "M"), Chr(10))
        arr_O = Split(Cells(i, "O"), Chr(10))
        arr_P = Split(Cells(i, "P"), Chr(10))
        arr_Q = Split(Cells(i, "Q"), Chr(10))
        Cells(i, "M") = arr_M(0)
        Cells(i, "O") = arr_O(0)
        Cells(i, "P") = arr_P(0)
        Cells(i, "Q") = arr_Q(0)
        For n = 1 To UBound(arr_M)
          Rows(i + n).Insert
          Cells(i + n, "M") = arr_M(n)
          Cells(i + n, "O") = arr_O(n)
          Cells(i + n, "P") = arr_P(n)
          Cells(i + n, "Q") = arr_Q(n)
        Next
          Range("J" & i).Resize(UBound(arr_M) + 1).FillDown
          Range("K" & i).Resize(UBound(arr_M) + 1).FillDown
      End If
    Next
End Sub
Проверка и формирование уникальных значений ячеек столбца таблицы
 
Цитата
есть еще предложения по поводу
С дополнительным столбцом
В ячейку В2 формулу =СЧЁТЕСЛИ($A$2:A2;A2) и тянем вниз
В ячейку С2 формулу =ЕСЛИ(B2=1;A2;A2&"-0"&(B2-1)) и тянем вниз

Или можно так =ЕСЛИ(СЧЁТЕСЛИ($A$2:A2;A2)=1;A2;A2&"-0"&(СЧЁТЕСЛИ($A$2:A2;A2)-1))
Изменено: Kuzmich - 7 Дек 2019 20:23:16
Упорядочивание по цифрам в ячейке с текстом
 
Если бы не было столбца с номером, то в ячейку А4 вставить формулу =ЗНАЧЕН(ПСТР(B4;6;2))
Протянуть вниз и затем сортировать таблицу по столбцу А
Проверка и формирование уникальных значений ячеек столбца таблицы
 
Цитата
А для чего делать копирование форматирования в столбец H?
В столбце Н формируется список уникальных значений, цвет остается от
применения расширенного фильтра. Можно в конце кода просто удалить столбец Н.
VBA Повторить каждую строку нужное кол-во раз
 
Код
Sub RazdelitStroki()
Dim i As Long
Dim iLastRow As Long
Dim n As Long
    iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
    For i = iLastRow To 2 Step -1
      Rows(i + 1).Resize(4).Insert
      Range(Cells(i, "A"), Cells(i, "C")).Resize(5).FillDown
    Next
End Sub
VBA Повторить каждую строку нужное кол-во раз
 
Ну и где на трех листах в примере надо повторять строки?
Проверка и формирование уникальных значений ячеек столбца таблицы
 
Результат в столбце В, попробуйте его очистить и запустить макрос
Проверка и формирование уникальных значений ячеек столбца таблицы
 
Цитата
Можно ли выполнить требование по уникальности в пределах двух столбцов ("исходный код" - "новый код"), без макросов
Я формулами не умею, вот попробуйте макрос
Код
Sub iKod()
Dim i As Long
Dim iLastRow As Long
Dim k As Long
Dim FoundArticul As Range
Dim FAdr As String
 iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
 Range("A1") = "Код"
 Range("B2:B" & iLastRow).ClearContents
 Range("H1:H" & iLastRow).ClearContents
    'уникальные из А в столбец H
 Range("A1:A" & iLastRow).AdvancedFilter xlFilterCopy, CopyToRange:=Range("H1"), Unique:=True
 iLastRow = Cells(Rows.Count, "H").End(xlUp).Row
      For i = 2 To iLastRow                        'цикл по уникальным
        Set FoundArticul = Columns(1).Find(Cells(i, "H"), , xlValues, xlWhole)
         If Not FoundArticul Is Nothing Then       'первое совпадение
            FAdr = FoundArticul.Address            'адрес первого совпадения
            Cells(FoundArticul.Row, "B") = Cells(FoundArticul.Row, "A")
            k = 1
          Do                                       'ищем следующее совпадение
           Set FoundArticul = Columns(1).FindNext(FoundArticul)
           If FoundArticul.Address <> FAdr Then    'есть еще совпадение
             Cells(FoundArticul.Row, "B") = Cells(FoundArticul.Row, "A") & "-0" & k
             k = k + 1
           End If
          Loop While FoundArticul.Address <> FAdr  'ищем совпадения пока не дойдем до FAdr
         End If
      Next
        Range("H1:H" & iLastRow).ClearContents
End Sub
Отобразить в ячейке номера всех участков при совпадении даты и инвентарного номера
 
Chevyyy,
А столбец с первой датой в листах Ноябрь и !С всегда одни и те же?
А то в примере и на рисунке есть расхождения.
Отобразить в ячейке номера всех участков при совпадении даты и инвентарного номера
 
Chevyyy,
С таким отношением к теме нутром я чую,
что лист Декабрь вам лопатить вручную.
Автоматические формулы подсчёта отфильтрованных данных
 
А, если в промежуточных итогах вместо 1 поставить 101
Как в макросе определить, какой тип переменной должен быть?
 
suricat555,
Посмотрите в теме https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=123470
Там есть создание отдельных листов по критерию. Удачи!
Отобразить в ячейке номера всех участков при совпадении даты и инвентарного номера
 
Chevyyy,
На листе "1С" в столбцах с датами есть объединенные ячейки. Это издержки программы 1С?
Можно ли от них избавиться?
Копирование без формата ячеек при сборе данных с листов книги, модификация макроса из Приема "Сборка данных со всех листов книги в одну таблицу"
 
Код
Set wbCurrent = ActiveWorkbook
Set wbReport = ActiveWorkbook

Это зачем, если вы работаете в одной книге?
Копирование без формата ячеек при сборе данных с листов книги, модификация макроса из Приема "Сборка данных со всех листов книги в одну таблицу"
 
Я пример не смотрел, но попробуйте
Код
rngData.Copy 
wbReport.Worksheets(1).Cells(n + 1, 1).PasteSpecial xlPasteValues
Копирование без формата ячеек при сборе данных с листов книги, модификация макроса из Приема "Сборка данных со всех листов книги в одну таблицу"
 
Использовать PasteSpecial xlPasteValues
Замена разного текста из разных ячеек.
 
Цитата
просто нужно
Так попробуйте
Замена разного текста из разных ячеек.
 
Код
Sub Zamena()
Dim i As Long
Dim iLastRow As Long
 iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
  For i = 2 To iLastRow
    If InStr(1, "холодильник , телевизор , автомобиль ", Cells(i, 1)) <> 0 Then
      Cells(i, 1) = "1"
    End If
  Next
End Sub
Нарезка таблицы на отдельные книги (макрос в книге с исходной таблицей)
 
Цитата
Нашел в сети макрос, который открывает другую книгу и режет ее на отдельные книги фильтрацией.
В книге макрос предлагает вам выбрать папку, в которую будет происходить нарезка, но не открывает другую книгу.
Разбираться в чужом коде нет желания. Посмотрите макрос, который режет вашу таблицу на отдельные листы.
Код
Sub iDogovor()
Dim i As Long
Dim n As Integer
Dim Criterij As String
Dim iName As String
Dim Sht As Worksheet
Application.ScreenUpdating = False
  Set Sht = ThisWorkbook.Worksheets("Исходник")
        Columns("AZ").ClearContents
     'отбор уникальных значений столбца B в столбец AZ
    Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy _
                                  , CopyToRange:=Range("AZ1"), Unique:=True
     'количество уникальных значений
        n = Cells(Rows.Count, "AZ").End(xlUp).Row
    For i = 2 To n          'цикл по уникальным значениям
        Criterij = Sht.Cells(i, "AZ")
        iName = Criterij    'имя нового листа
     'ставим автофильтр по столбцу B
       Sht.Range("A1:AS" & Sht.Cells(Sht.Rows.Count, "B").End(xlUp).Row).AutoFilter 2, Criterij
     'копируем видимые строки в новый лист
        Sht.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy
        With Worksheets.Add(After:=Worksheets(Worksheets.Count))  'добавляет новый лист в конец
          .Range("A1:AS1").PasteSpecial xlPasteColumnWidths
          .Range("A1:AS1").PasteSpecial xlPasteFormats
          .Range("A1:AS1").PasteSpecial xlPasteValues
          Sht.AutoFilter.Range.AutoFilter
          .Name = iName
          .Range("A1").Select
        End With
    Next
      Sht.Activate
Application.ScreenUpdating = True
End Sub
Поиск и замена по маске, Есть артикулы в тексте, нужно найти их по маске и заключить в скобки
 
Цитата
сработал последний паттерн
Сначала делаете цикл по первому паттерну, затем по второму
Поиск и замена по маске, Есть артикулы в тексте, нужно найти их по маске и заключить в скобки
 
Цитата
1. Удалить артикул по патерну
заменить строку
Код
Cells(i, 2) = .Replace(Cells(i, 1), "")

Цитата
2. Удалить все кроме артикула
Код
Cells(i, 2) = .Execute(Cells(i, 1))(0)
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 217 След.
Наверх