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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 200 След.
Поиск и суммирование по столбцам и строкам
 
А что д.б.  в столбце "не кофе" и "остальное". И как их отличить?
поиск повторяющихся значений и перенос их на другой лист (VBA), найти и перенести повторы
 
Цитата
в строке 36  "End With" не лишнее?
Лишнее, это осталось от предыдущего сообщения, которое автор исправил
поиск повторяющихся значений и перенос их на другой лист (VBA), найти и перенести повторы
 
Я имел в виду этот кусок макроса
Код
    With sht
        .Range("K2:K" & x).NumberFormat = "@"
        .[a1].Resize(x, UBound(arr, 2)) = arr
        .Name = "Дубли"
        .Columns.AutoFit
    End With
Чтобы не было преобразования в дату
поиск повторяющихся значений и перенос их на другой лист (VBA), найти и перенести повторы
 
Nordheim, написал
Цитата
С какой целью?
Просто на листе Дубли в столбце К появляются ячейки с янв.92 вместо 1-92
Изменено: Kuzmich - 17 Авг 2018 13:17:18
поиск повторяющихся значений и перенос их на другой лист (VBA), найти и перенести повторы
 
Nordheim,  
Определите sht1    
Код
  Set sht1 = ThisWorkbook.Worksheets("Пример на форум")
при формировании листа Дубли я бы добавил первой строку
Код
.Range("K2:K" & x).NumberFormat = "@"
Изменено: Kuzmich - 17 Авг 2018 12:48:30
Как удалить все что не 4 цифры между разделителями?
 
Цитата
Может регулярными выражениями?
Код
Sub iNomer()
Dim mo As Object
Dim n As Integer
Dim i As Long
Dim j As Integer
 With CreateObject("VBScript.RegExp")
   .Global = True
   .MultiLine = True
   .Pattern = "\d{4}_____"
     If .test(Cells(2, "A")) Then
       Set mo = .Execute(Cells(2, "A"))
           j = 2
         For n = 0 To mo.Count - 1
           Cells(2, "B") = Cells(2, "B") & mo(n)
           j = j + 1
         Next
           Cells(2, "B") = Left(Cells(2, "B"), Len(Cells(2, "B")) - 5)
    End If
 End With
End Sub
Создание итоговых данных по заполненной таблице, Как реализовать добавление нужных строк в итоговую таблицу
 
Несколько другой алгоритм создания актов
заполнение ячеек данными по реальной дате, Автозаполнение ячеек данными от текущей даты
 
Подразумевается, что на листе УЧЕТ ЛЮДЕЙ данные за определенный день (сегодняшняя дата) и их надо перенести
на лист учет по смг в строку с этой датой. Почему даты за сентябрь, если сейчас август?
заполнение ячеек данными по реальной дате, Автозаполнение ячеек данными от текущей даты
 
Цитата
как сделать так что бы данные заносились туда по датам?   и брались из листа учет людей
На листе УЧЕТ ЛЮДЕЙ нет даты
Еслиошибка() как реализовать VBA
 
М.б.
Код
WorksheetFunction.IsError
VBA. Макрос очищения определенных столбцов по названию.
 
Цитата
если в заголовке несколько слов через пробел
А вы можете записать Цена-Конкурента или Цена_Конкурента ?
Изменено: Kuzmich - 15 Авг 2018 13:38:08
Поиск по фразам макросом
 
Находясь на листе 1 запустите макрос, Id  в столбце D
Код
Sub PoiskFIO()
Dim i As Long
Dim iLastRow As Long
Dim FoundFIO As Range
Application.ScreenUpdating = False
With Worksheets("2")
 iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
  For i = 2 To iLastRow
    Set FoundFIO = Columns("A").Find(.Cells(i, "A"), , xlValues, xlPart)
    If Not FoundFIO Is Nothing Then
      Cells(FoundFIO.Row, "D") = .Cells(i, "B")
    End If
  Next
End With
Application.ScreenUpdating = True
End Sub
Поиск по фразам макросом
 
А, если будут однофамильцы?
VBA. Макрос очищения определенных столбцов по названию.
 
По мотивам макроса Казанского, но без применения умной таблицы
Код
Sub iColumnsClear()
Dim x
Dim iLastRow As Long
Dim x_col As Integer
   For Each x In Split("ъ кк ее нн гг")              'перечислите заголовки столбцов через пробел
     x_col = Rows(8).Find(x, , xlValues, xlWhole).Column
     iLastRow = Cells(Rows.Count, x_col).End(xlUp).Row
     Range(Cells(9, x_col), Cells(iLastRow, x_col)).ClearContents
   Next
End Sub

VBA. Удаление ячеек по условию, Нужно удалить ячейки, а не строки
 
Используйте конструкцию With......End With
В конец макроса Sub Spiski_delete() добавьте
Код
With Sheets("Управленческие расходы")
   iLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
  For i = iLastRow To 16 Step -1
   If .Cells(i, "A") = "{10} Материальные затраты" Or .Cells(i, "A") = "{50} Прочие затраты" Then
     .Cells(i, "A").ClearContents
   End If
  Next
End With
VBA. Удаление ячеек по условию, Нужно удалить ячейки, а не строки
 
С какого листа вы запускаете макрос Sub Spiski_delete() ?
Есть ли у вас отдельная кнопка, по которой запускается макрос?
VBA. Удаление ячеек по условию, Нужно удалить ячейки, а не строки
 
Так макрос и убирает ячейки с яблоками и грушами в столбце А с одного листа
VBA. Удаление ячеек по условию, Нужно удалить ячейки, а не строки
 
Вам надо, чтобы макрос со всех листов убрал ячейки с яблоками и грушами в столбце А ?
Сделайте цикл по всем листам.
Создание итоговых данных по заполненной таблице, Как реализовать добавление нужных строк в итоговую таблицу
 
У вас в таблице для каждой ФИО в столбцах проставлено фактическое количество?
А где берется плановое?
Создание итоговых данных по заполненной таблице, Как реализовать добавление нужных строк в итоговую таблицу
 
Цитата
как реализовать одну задачу?
Создать лист-шаблон (Акт сдачи-приемки оказанных услуг).
Затем макросом в цикле проходите по всем ФИО и работам,
создавая свой лист, используя шаблон и заполняя его на
основании листа Данные
VBA. Удаление ячеек по условию, Нужно удалить ячейки, а не строки
 
Код
Sub Tablica()
Dim i As Long
Dim iLastRow As Long
 iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
  For i = iLastRow To 2 Step -1
    If Cells(i, "A") = "яблоки" Or Cells(i, "A") = "груши" Then
      Cells(i, "A").Delete
    End If
  Next
End Sub
Копирование даты (текста) из одних ячеек в другие при определенных условиях
 
Цитата
Существует ли вариант
Макросом
Код
Sub iBIK()
Dim iDate As Date
Dim FoundCell As Range
Dim FAdr As String
   iDate = Split(Range("C2"), ":")(1)
    Set FoundCell = Columns("E:F").Find("БИК", , xlValues, xlPart)
     If Not FoundCell Is Nothing Then
      FAdr = FoundCell.Address
      Do
       Cells(FoundCell.Row, "B") = iDate
       Set FoundCell = Columns("E:F").FindNext(FoundCell)
      Loop While FoundCell.Address <> FAdr
     End If
End Sub
Объединение значений нескольких столбцов содержащих адрес в один столбец с помощью макроса
 
Цитата
с помощью макроса
Код
Sub iConcatenate()
Dim i As Long
Dim iLastRow As Long
Dim j As Integer
 iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
  For i = 2 To iLastRow
    For j = 1 To 6
      If Not IsEmpty(Cells(i, j)) Then
        Select Case j
          Case 1
            Cells(i, "G") = Cells(i, "A") & ", "
          Case 2
            Cells(i, "G") = Cells(i, "G") & Cells(i, "B") & "." & Cells(i, "C") & ", "
          Case 4
            Cells(i, "G") = Cells(i, "G") & "д." & Cells(i, "D") & ","
          Case 5
            Cells(i, "G") = Cells(i, "G") & "корп." & Cells(i, "E") & ","
          Case 6
            Cells(i, "G") = Cells(i, "G") & "кв." & Cells(i, "F")
        End Select
      End If
    Next
  Next
End Sub
VBA найти данные по двум критериям
 
Код
Sub Poisk()
Dim i As Long
Dim iLastRow As Long
Dim FoundCell As Range
Application.ScreenUpdating = False
 With Worksheets("Лист2")
   iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
   For i = 2 To iLastRow
     .Cells(i, "D") = .Cells(i, "A") & "|" & .Cells(i, "B")
   Next
     iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
  For i = 2 To iLastRow
    Set FoundCell = .Columns("D").Find(Cells(i, "A") & "|" & Cells(i, "B"), , xlValues, xlWhole)
    If Not FoundCell Is Nothing Then
      Cells(i, "C") = .Cells(FoundCell.Row, "C")
    End If
  Next
    .Columns("D").Delete
 End With
Application.ScreenUpdating = True
End Sub
Запускать с лист1
VBA найти данные по двум критериям
 
А ERUO и UERO что за валюта?
Изменено: Kuzmich - 11 Авг 2018 11:45:27
Функция СЦЕПИТЬ. Выделить часть текста жирным
 
Макросом. В ячейке А1 ваша формула, выделение даты в ячейке В1
Код
Sub iBoldData()
   Cells(1, 1).Copy
   Cells(1, 2).PasteSpecial xlPasteValues
 With CreateObject("VBScript.RegExp")
     .Global = True
     .Pattern = "\d{2}\.\d{2}\.\d{2,4}"
     If .Test(Cells(1, 2)) Then
       Cells(1, 2).Characters(.Execute(Cells(1, 2))(0).FirstIndex + 1, _
                  .Execute(Cells(1, 2))(0).Length).Font.Bold = True
     End If
 End With
End Sub
[VBA] Сделать подсчет символов в ячейке и если их меньше 50, то прибавить в конце пробел/пробелы
 
Range("A" & i)=Range("A" & i) & Space(50 - Len(Range("A" & i)))
Добавить тег к каждому переносу
 
Код
Sub InsTeg()
Dim arr
Dim j As Integer
  arr = Split(Cells(1, 1), Chr(10))
  For j = 0 To UBound(arr)
    arr(j) = arr(j) & "<br />"
  Next
  Cells(1, 2) = Join(arr, Chr(10))
End Sub
Сумма ячеек Excel по 2 условиям при условии что одно общее, Сумма ячеек Excel по 2 условиям при условии что одно общее
 
Код
Sub Profit()
Dim i As Long
Dim FoundCell As Range
Dim Zavod As String
Dim iSumma As Double
Dim SvodTablRow As Long
   SvodTablRow = Columns("A").Find("СВОДДНАЯ ТАБЛИЦА", , xlValues, xlWhole).Row
    Range("F" & SvodTablRow + 1 & ":F" & SvodTablRow + 4).ClearContents
  For i = SvodTablRow + 1 To SvodTablRow + 4
     iSumma = 0
      Zavod = Cells(i, "A") & " Итого"
    Set FoundCell = Range("A4:A" & SvodTablRow).Find(Zavod, , xlValues, xlWhole)
     If Not FoundCell Is Nothing Then
       iSumma = iSumma + FoundCell.Offset(12, 3)
        Cells(i, "F") = iSumma
     End If
  Next
End Sub
Сумма ячеек Excel по 2 условиям при условии что одно общее, Сумма ячеек Excel по 2 условиям при условии что одно общее
 
Hugo,
У меня ваш код выдал
Завод10
Транспорт450
Склад450
Прибыль1700
0
Завод20
Звод20
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 200 След.