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

Страницы: 1
Поиск повторяющихся значений и перенос их на другой лист (VBA)
 
Конечно. А что Вас смутило?

P.S. Не совсем понимаю, что именно нужно mtts54 получить. Таблицу с дублями?
Поиск повторяющихся значений и перенос их на другой лист (VBA)
 
Вроде бы, быстрый макрос
Код
Sub МакросДублей()
    
    Sheets.Add(after:=Sheets(1)).Name = "Лист_дублей"
    Sheets(1).Select

    Dim lLastRow As Long, lLastCol As Long, i As Long, j As Long, k As Long, _
        arrayTable() As Variant, arrayTemp() As Variant
    
    lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    lLastCol = Cells(1, Columns.Count).End(xlToLeft).Column + 1
    
    Cells(1, lLastCol) = "№ п/п"
    Cells(2, lLastCol) = 1
    Cells(3, lLastCol) = 2
    Range(Cells(2, lLastCol), Cells(3, lLastCol)).AutoFill _
        Destination:=Range(Cells(2, lLastCol), Cells(lLastRow, lLastCol))
    Range(Cells(2, 1), Cells(lLastRow, lLastCol)).Sort _
        key1:=Range("G2:G" & lLastRow), order1:=xlAscending, Header:=xlNo
        
    arrayTable = Range(Cells(1, 1), Cells(lLastRow + 1, lLastCol)).Value
    ReDim arrayTemp(0 To lLastRow - 1, 1 To lLastCol)
    
    k = 1
    For i = 1 To lLastRow Step 1
        If arrayTable(i, 7) = arrayTable(i + 1, 7) _
            Or arrayTable(i, 7) = arrayTemp(k - 1, 7) _
        Then
            For j = 1 To lLastCol Step 1
                arrayTemp(k, j) = arrayTable(i, j)
            Next j
            k = k + 1
        End If
    Next i
    
    Sheets("Лист_дублей").Range("A1").Resize(k, lLastCol) = arrayTemp
    Range(Cells(1, 1), Cells(1, lLastCol)).Copy Sheets("Лист_дублей").Range("A1")
    Sheets("Лист_дублей").Range("G1").ColumnWidth = 12
    
    Range(Cells(2, 1), Cells(lLastRow, lLastCol)).Sort _
        key1:=Range(Cells(2, lLastCol), Cells(lLastRow, lLastCol)), _
        order1:=xlAscending, Header:=xlNo
    Range(Cells(1, lLastCol), Cells(lLastRow, lLastCol)).ClearContents
    
    Sheets("Лист_дублей").Select
End Sub
Нахождение корней с помощью "Поиск Решения", Найти корни матричного уравнения АХ=В
 
lolpol, Вы учитываете при решении, что умножение матриц некоммутативно, т.е. AB =/= BA ?
Макрос - проверка внесение даты
 
bobyjoy, Вот булева функция для проверки, является выражение датой по григорианскому календарю в формате ДД.ММ.ГГГГ

Код
Function isGregorianDate(data As String) As Boolean
 
    'Проверка, соответствует ли дата формату ДД.ММ.ГГГГ
    If Not data Like "##.##.####" Then
        isGregorianDate = False
        Exit Function
    End If
 
    Dim d As String, m As String, y As String
    d = Left(data, 2)   'день
    m = Mid(data, 4, 2) 'месяц
    y = Mid(data, 7, 4) 'год
     
    If (d = 0 Or m = 0 Or m > 12 Or y = 0 _
        Or ((m = 1 Or m = 3 Or m = 5 Or m = 7 Or m = 8 Or m = 10 Or m = 12) And d > 31) _
        Or ((m = 4 Or m = 6 Or m = 9 Or m = 11) And d > 30) _
        Or (m = 2 And Not (d < 29 Or (d < 30 And y Mod 4 = 0 _
                And (y < 1582 Or y Mod 100 <> 0 Or y Mod 400 = 0))))) _
    Then
        isGregorianDate = False
        Exit Function
    End If
     
    isGregorianDate = True
     
End Function


Дальше сами.
Сохранить выделенный диапазон как картинку отдельным файлом
 
Казанский,  благодарю!
Оказалось проще, чем думал.
Сохранить выделенный диапазон как картинку отдельным файлом
 
Подскажите, как при преобразовании выделенного диапазона в картинку вызвать стандартное диалоговое окно для сохранения файлов, чтобы пользователь мог указать путь и имя файла?


Код
Sub RangeToPicture()
    If TypeName(Selection) <> "Range" Then
        MsgBox "Выделенная область не является диапазоном."
        Exit Sub
    End If
    Dim imgName As String, wsTmpSh As Worksheet
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    With Selection
        .CopyPicture
        Set wsTmpSh = ThisWorkbook.Sheets.Add
        imgName = "Range_" & Format(Now(), "yyyymmdd") & Replace(Timer, ",", "")
        With wsTmpSh.ChartObjects.Add(0, 0, .Width, .Height).Chart
            .ChartArea.Border.LineStyle = 0
            .Parent.Select
            .Paste
            .Export Filename:=ActiveWorkbook.Path & "\" & imgName & ".png", FilterName:="PNG"
            .Parent.Delete
        End With
    End With
    wsTmpSh.Delete
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
Разнести текст по ячейкам.
 
Во вкладке Данные инструмент Текст по столбцам.
Подсчет всех сумм итогов по условию
 
BladzheR,
например, можно с помощью функции СУММЕСЛИ.
Дата прописью, Функция представления прописью даты в формате ДД.ММ.ГГГГ
 
Шит,
я меня есть VBA-функция для представления дат (от 01.01.0001 до 31.12.9999) прописью, я предлагаю Николаю Павлову добавить такую функцию в PLEX, думаю, многим пользователям она пригодится.
Изменено: dext - 15.10.2017 09:08:17
Дата прописью, Функция представления прописью даты в формате ДД.ММ.ГГГГ
 
Предлагаю добавить в PLEX функцию представления прописью даты в формате ДД.ММ.ГГГГ.
Довольно часто нужно в различных документах записывать дату прописью, а в PLEX нет такой возможности  :(
Проверить, является ли строка датой по григорианскому календарю, Нужна булевая функция для проверки, является ли строка датой в формате ДД.ММ.ГГГГ по григорианскому календарю
 
Кнопка цитирования не для ответа [МОДЕРАТОР]

Если использовать функцию на рабочем листе, без разницы в каком формате ("Дата" или "Текстовый") отображается в ячейке дата вида ДД.ММ.ГГГГ.
Проверить, является ли строка датой по григорианскому календарю, Нужна булевая функция для проверки, является ли строка датой в формате ДД.ММ.ГГГГ по григорианскому календарю
 
Sanja, функция IsDate некорректно проверяет даты до 100 г. н. э., также у неё слишком большой диапазон проверяемых форматов дат, например, isDate(1.72)=True.
Изменено: dext - 02.10.2017 19:23:30
Проверить, является ли строка датой по григорианскому календарю, Нужна булевая функция для проверки, является ли строка датой в формате ДД.ММ.ГГГГ по григорианскому календарю
 
Коллеги, подскажите, есть ли в VBA специальная функция для проверки, является ли строка датой в формате ДД.ММ.ГГГГ по григорианскому календарю?
Нужно проверять даты от 1 г. н. э. до 9999 г. н. э. :)
На скорую получилось, что-то громоздкое и не быстрое :(

Код
'Булевая функция для проверки, является ли строка датой
' в формате ДД.ММ.ГГГГ по григорианскому календарю
Function isGregorianDate(data As String) As Boolean

    'Проверка, соответствует ли дата формату ДД.ММ.ГГГГ
    If Not data Like "##.##.####" Then
        isGregorianDate = False
        Exit Function
    End If

    Dim d As String, m As String, y As String
    d = Left(data, 2)   'день
    m = Mid(data, 4, 2) 'месяц
    y = Mid(data, 7, 4) 'год
    
    'Проверка, корректная ли дата по григорианскому календарю.
    ' До 1582 г. все года н.э., делящиеся на 4, считаются високосными,
    ' после только те года, которые делятся на 4 и не деляться на 100 или делятся на 400;
    ' если нужно учитывать високосные года до принятия григорианского календаря в России в 1918 г.,
    ' то замените в коде 1582 в "y < 1582" на 1918.
    ' https://ru.wikipedia.org/wiki/Високосный_год#Григорианский_календарь
    If (d = 0 Or m = 0 Or m > 12 Or y = 0 _
        Or ((m = 1 Or m = 3 Or m = 5 Or m = 7 Or m = 8 Or m = 10 Or m = 12) And d > 31) _
        Or ((m = 4 Or m = 6 Or m = 9 Or m = 11) And d > 30) _
        Or (m = 2 And Not (d < 29 Or (d < 30 And y Mod 4 = 0 _
                And (y < 1582 Or y Mod 100 <> 0 Or y Mod 400 = 0))))) _
    Then
        isGregorianDate = False
        Exit Function
    End If
    
    isGregorianDate = True
    
End Function
Изменено: dext - 02.10.2017 19:43:42 (Опечатки в коде)
Количество уникальных значений по условию
 
Попробуйте сводную таблицу:
- в название строк столбец с датами;
- в название столбцов и в значения столбец с именами.
Объединение в диапазоны подряд идущих номеров по условию, оптимизировать код
 
Мотя,
оно просто группирует номера сертификатов по офису и статусу без группировки в диапазоны подряд идущих, манагерам будет сложней проанализировать.
Изменено: dext - 13.06.2017 08:52:53
Суммирование значений ячеек с одинаковым названием
 
Jonny,
Если правильно понял, попробуйте эту формулу

Код
=ЕСЛИ(СУММЕСЛИ($B$2:$B$8;B11;$F$2:$F$8)>0;F11+СУММЕСЛИ($B$2:$B$8;B11;$F$2:$F$8);"")
Объединение в диапазоны подряд идущих номеров по условию, оптимизировать код
 
nodirstein, в столбце "Номер или диапазон номеров" везде "#ИМЯ?".
Объединение в диапазоны подряд идущих номеров по условию, оптимизировать код
 
название "Объединение в диапазоны подряд идущих номеров по условию",
описание "нужна помощь с оптимизацией кода"
Объединение в диапазоны подряд идущих номеров по условию, оптимизировать код
 
Цитата
Sanja написал:
У Вас тема с нарушением Правил форума, поэтому, дабы не навлечь на себя гнев модераторов
В чем нарушение?
Объединение в диапазоны подряд идущих номеров по условию, оптимизировать код
 
Добрый вечер,
помогите с оптимизацией кода (см. вложенный файл). Есть отчёт в табличном виде
№ п/п№ партииДатаОфисНомер сертификатаСтатус
123456
1 Главный офис901200001выдан
2 Главный офис901200002выдан
3 Главный офис901200003выдан
4 Главный офис901200004выдан
5 Доп. офис №1901200005выдан
6 Главный офис901200006выдан
7 Доп. офис №1901200007выдан
8 Доп. офис №1901200008выдан
9 Главный офис901200009выдан
10 Главный офис901200010испорчен
11 Главный офис901200011чистые
12 Главный офис901200012чистые
13 Главный офис901200013выдан
14 Главный офис901200014чистые
15 Главный офис901200015выдан
16 Главный офис901200016выдан
17 Доп. офис №2901200017испорчен
18 Доп. офис №2901200018выдан
19 Доп. офис №2901200019выдан
20 Главный офис901200020выдан
Нужно объединить в диапазоны подряд идущие номера сертификатов (5-й столбец)  с одинаковым статусом (6-й столбец) и офисом (4-й столбец) и результат представить в новой таблицу, т.е. на основе таблицы после преобразований должна получиться таблица (см. ниже). Макрос написал (в файле), но он тормозит на больших таблицах :cry: . Просьба подсказать, как оптимизировать код.
Номер или диапазон номеровКоличествСтатусОфис
1901200001-9012000044выданГлавный офис
29012000051выданДоп. офис №1
39012000061выданГлавный офис
4901200007-9012000082выданДоп. офис №1
59012000091выданГлавный офис
69012000101испорченГлавный офис
7901200011-9012000122чистыеГлавный офис
89012000131выданГлавный офис
99012000141чистыеГлавный офис
10901200015-9012000162выданГлавный офис
119012000171испорченДоп. офис №2
12901200018-9012000192выданДоп. офис №2
139012000201выданГлавный офис
Итого 20
Изменено: dext - 12.06.2017 22:27:39
Тестовое задание по Excel на должность аналитика
 
Но в тесте отчества у всех же есть, и даже без оглы и кызы :)
Тестовое задание по Excel на должность аналитика
 
Это только 1-я часть тестового задания на проверку навыков работы с Excel, будет ещё одна на обработку больших таблиц с помощью сводных и макросов. Симферополь.
Тестовое задание по Excel на должность аналитика
 
Здравствуйте,
на работе попросили придумать тестовое задание по Excel на должность аналитика средней степени сложности.
Что-то на досуге наварганил, прошу протестировать. Тянут ли задания на среднюю степень сложности?

Может у кого есть свои тестовые задания для соискателей, скиньте, пожалуйста.
Страницы: 1
Наверх