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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 208 След.
Вытягивание значений до и после определенного слова
 
Код
Sub iКВ()
Dim i As Long
Dim iLastRow As Long
  iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Range("B5:C" & iLastRow).ClearContents
 With CreateObject("VBScript.RegExp")
     '.Global = True
     .IgnoreCase = True
     .Pattern = "\,? ?КВ\.?"
   For i = 5 To iLastRow
     If .test(Cells(i, 1)) Then
       Cells(i, 2) = Left(Cells(i, 1), .Execute(Cells(i, 1))(0).FirstIndex)
       Cells(i, 3) = Mid(Cells(i, 1), .Execute(Cells(i, 1))(0).FirstIndex + .Execute(Cells(i, 1))(0).Length + 1)
     Else
       Cells(i, 2) = Cells(i, 1)
     End If
   Next
 End With
End Sub
Разделение в столбцы В и С
[ Закрыто] возможности excel-2003, об использования excel-2003
 
Цитата
как в excel-2003 активировать
Меню Вид - Панели инструментов - поставить галочки у Формы и Элементы управления
Поиск значения по 3м условиям
 
В модуль листа Лист3
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim FoundYear As Range
    If Not Intersect(Target, Range("B17")) Is Nothing Then
        Application.EnableEvents = False
     Set FoundYear = Rows(1).Find(Target, , xlValues, xlWhole)
      If Not FoundYear Is Nothing Then
        Range(Cells(FoundYear.Row + 3, FoundYear.Column), Cells(FoundYear.Row + 12, FoundYear.Column + 12)).Copy _
        Cells(Target.Row + 1, Target.Column + 1)
      End If
    End If
    Application.EnableEvents = True
End Sub
Макрос для подстановки значений через определенное сочетание в пределах одного листа
 
Кросс
http://www.excelworld.ru/forum/10-42748-1
Поиск артикула в ячейке с большим текстовым массивом
 
Sanja, написал, что отображаются только 1024 знака
У меня в ячейке В2 1253 знака и все видны на экране.
Мой макрос находит и подсвечивает 6 соответствий, а макрос от Настя_Nastya ничего не находит.
Я и хочу узнать почему?
Поиск артикула в ячейке с большим текстовым массивом
 
Хотелось бы понять причину такого поведения функции InStr в Excel 2003
Поиск артикула в ячейке с большим текстовым массивом
 
У меня Excel 2003, может он накладывает ограничения
Поиск артикула в ячейке с большим текстовым массивом
 
Цитата
Вы проверяли свой макрос при таком же условии?
Да, проверял. Вставил артикул из А1 несколько раз в разные места ячейки В1. Мой макрос находит все вхождения, а ваш не обнаруживает значения, которые находятся после тысячного (это не точное значение) знакоместа. Попробуйте.
Макрос должен срабатывать на текущем листе
 
Цитата
макрос работает только на странице которая в sheets прописана
А где расположен макрос? В стандартном модуле или в модуле листа?
Поиск артикула в ячейке с большим текстовым массивом
 
Настя_Nastya, проверьте ваш макрос при условии, что искомый артикул будет в конце ячейки В1.
Помню, что было какое-то ограничение для InStr при большой длине предложения.
Поиск артикула в ячейке с большим текстовым массивом
 
Код
Sub iArticul()
Dim i As Long
Dim j As Integer
Dim iLR As Long
Dim re As Object
Dim objMatches As Object
Dim objMatch As Object
  iLR = Cells(Rows.Count, "A").End(xlUp).Row
      Columns("B:B").Font.ColorIndex = 0
  For i = 1 To iLR
      Set re = CreateObject("VBScript.RegExp")
          re.Global = True
          re.IgnoreCase = True
          re.Pattern = Cells(i, "A")
        Set objMatches = re.Execute(Cells(i, "B"))
          If objMatches.Count <> 0 Then
             For j = 0 To objMatches.Count - 1
                Set objMatch = objMatches.Item(j)
                With Cells(i, "B").Characters(Start:=objMatch.FirstIndex + 1, Length:=objMatch.Length).Font
                    .ColorIndex = 3
                End With
             Next
          End If
        Set re = Nothing
    Next
End Sub
Поиск артикула в ячейке с большим текстовым массивом
 
Цитата
есть столбец А с артикулами
А в каждой ячейке столбца А только один артикул?
Что такое в коде := двоеточие и равно
 
Цитата
перечисляю критерии в столбик, то не работает.
Код
Cells.AutoFilter _
Field:=1, _
Criteria1:="*Москва*"
Разделить строку по строчным и прописным
 
Цитата
нужно разделить строку по столбцам
Если предложение в ячейке А1, то запускаете макрос и он делит в В1 и С1
Код
Sub ПрописныеСтрочные()
Dim mo As Object
 With CreateObject("VBScript.RegExp")
   .Global = True
   .MultiLine = True
   .Pattern = "^[А-ЯЁ ]+"
     If .test(Cells(1, 1)) Then
       Set mo = .Execute(Cells(1, 1))
       Cells(1, 2) = mo(0)
       Cells(1, 3) = Mid(Cells(1, 1), mo(0).Length + 1)
    End If
 End With
End Sub
Вытянуть данные из Книги данные соблюдая 2 значения
 
Цитата
конвектор из pdf в Эксель
Я использую конвертер
ABBYY PDF Transformer + , выпуск 12.0.104.225, артикул 1132.27
Позволяет в настройках выбор:
1. Игнорировать текст вне таблицы
2. Сохранять числовые данные в формате «цифры»
3. Сохранять колонтитулы
Разделить строку по строчным и прописным
 
Цитата
найти первый переход с прописной на строчную букву
А прописные всегда в начале предложения?
Получить список уникальных записей VBA
 
Цитата
нужно именно макросом
Код
iLastRow =Cells(Rows.Count, "A").End(xlUp).Row
 Range("A2:A" &iLastRow).AdvancedFilter xlFilterCopy, CopyToRange:=Range("C2"),Unique:=True

Копирование значений с одного листа на другой МАКРОС
 
Скопировали , затем вставляете только значения
Код
.Copy 
Sheets("Журнал проведения настройки").Range("a2").PasteSpecial xlPasteValues
и дальше также
Выделить жирным текст в ячейке по условию
 
Цитата
надо по условию Пробел-3цифры слитно - запятая  и выделить 3 цифры жирным
А, если таких условий несколько в ячейке?
Например ненгененггнгн, 205, 3-06,н, 205, 371-66-85н, 205,
Получить список уникальных записей VBA
 
Цитата
как создать уникальный список?
Использовать Расширенный фильтр
Перемещение слов по очереди в одной ячейке
 
Цитата
В пределах одной ячейки перемещать слова по очереди
Код
Sub Перестановка()
Dim arr
   arr = Split(ActiveCell, " ", 2)
   ActiveCell = arr(1) & " " & arr(0)
End Sub
VBA: разбивка с помощью макроса объединенных ячеек
 
Цитата
чтобы он работал в конкретном выделенном столбце или, ещё лучше, диапазоне ячеек?
Так макрос и так работает с конкретным диапазоном ячеек от В2 и до последней ячейки в столбце В.
Cells(i, 2) - цифра 2 указывает на столбец В, если нужен другой столбец, то поменяйте цифру.
Или замените цикл For i = 2 To iLastRow на цикл по выделенному диапазону Selection. Удачи!
Объединить текст и число с разным размером шрифтов
 
Код
Sub FontSize()
Dim i As Long
Dim iLastRow As Long
 iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
  For i = 2 To iLastRow
    Cells(i, 16) = Cells(i, 2) & vbLf & "руб, 1 шт"
    Cells(i, 16).Font.Size = 27
    Cells(i, 16).Font.Bold = True
     With Cells(i, 16).Characters(Len(Cells(i, 2)) + 1, 10).Font
       .Size = 10
       .Bold = False
     End With
  Next
End Sub
VBA если ячейка заполнена
 
А как ваша тема "Собрать данные со всех листов в книге по критерию и перенести в единый лист с указанием листов" ?
VBA: разбивка с помощью макроса объединенных ячеек
 
Цитата
можно ли сделать эту операцию с помощью какого-либо макроса?
Код
Sub Tablica()
Dim i As Long
Dim iLastRow As Long
Dim n As Integer
 iLastRow = Cells(Rows.Count, 2).End(xlUp).Row
  For i = 2 To iLastRow
    If Cells(i, 2).MergeCells Then
      n = Cells(i, 2).MergeArea.Count
      Range(Cells(i, 2), Cells(i + n - 1, 2)).UnMerge
      Cells(i, 2).Resize(n) = Cells(i, 2)
    End If
  Next
End Sub
Собрать данные со всех листов в книге по критерию и перенести в единый лист с указанием листов
 
При активном листе РЕЗУЛЬТАТ запустите макрос
Код
ub Sbor()
Dim Sht As Worksheet
Dim iLastRow As Long
Dim iLR As Long
Dim Zavod As Range
  iLastRow = Cells(Rows.Count, "C").End(xlUp).Row
  If iLastRow = 3 Then iLastRow = 4
  Range("C4:D" & iLastRow).Clear
    For Each Sht In Worksheets
      If Sht.Name <> "РЕЗУЛЬТАТ" Then
        With Sht
         Set Zavod = .Rows("11").Find("Завод", , xlValues, xlWhole)
          If Not Zavod Is Nothing Then
            iLR = .Cells(.Rows.Count, Zavod.Column).End(xlUp).Row
            iLastRow = Cells(Rows.Count, "C").End(xlUp).Row + 1
            .Range(.Cells(12, Zavod.Column), .Cells(iLR, Zavod.Column)).Copy Cells(iLastRow, "C")
            Cells(iLastRow, "D").Resize(iLR - 11) = Sht.Name
          End If
        End With
      End If
    Next
End Sub
Удаление строк после ячейки с определенными данными
 
Цитата
как макросом удалить 10 пустых строк, после строки
Код
Sub DelAfterWsego()
Dim FoundWsego As Range
    Set FoundWsego = Columns("A").Find("Всего", , xlValues, xlWhole)
    If Not FoundWsego Is Nothing Then
      Rows(FoundWsego.Row + 1 & ":" & FoundWsego.Row + 10).Delete
    End If
    Range("A1").Select
End Sub
Сокращение времени при поиске значения ячейки в диапазоне
 
Цитата
сократить скорость выполнения макроса
https://www.excel-vba.ru/chto-umeet-excel/kak-uskorit-i-optimizirovat-kod-vba/
Макрос. Копирование данных в лист другого файла с изменяющимся названием
 
Цитата
Если лист с таким именем существует, он не делает копирование данных
Макрос в сообщении 15 делает проверку наличия листа и, если листа нет, то добавляет его в книгу. А копирование данных добавьте в код
после проверки наличия листа
Макрос. Копирование данных в лист другого файла с изменяющимся названием
 
Цитата
на счет проверки наличия листа.
Код
Sub Copy_Data()
Dim sh_src As Worksheet, sh_res As Worksheet
 Set sh_src = Workbooks("Book1.xlsm").Worksheets("Invoices")
Dim Sh_name As String
    Sh_name = Workbooks("Book1.xlsm").Worksheets("Macro").Range("E6").Text
     Workbooks("Book2.xlsm").Activate
      If Not SheetExist(Sh_name) Then  'функция проверки наличия листа в файле
        sh_src.Copy After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = Sh_name
      End If
   MsgBox ("INCOICES DOWNLIADING - Complete!")
End Sub

     'функция проверки наличия листа в файле, лист есть - true
Function SheetExist(iName As String) As Boolean
    On Error Resume Next
    With Worksheets(iName): End With
    SheetExist = (Err = 0)
End Function

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 208 След.
Наверх