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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 120 След.
Сбор и преобразование данных с разных листов книги, исходные данные "в неудобном" виде
 
Vasya Ivanoff, а если никто бесплатно не поможет и нужен будет макрос, то могу написать вам платно макрос, который соберёт ваши таблицы, как в вашем примере. Но будем надеяться, что кто-то поможет
Изменено: New - 05.07.2022 15:04:37
Выгрузить цену на товар с сайта ozon.ru
 
как один из вариантов - создать тему в разделе Работа (да, на нашем форуме есть такой раздел) - может там кто за деньги возьмётся вам помочь.
Изменено: New - 04.07.2022 23:30:52
Сравнительная характеристика массивов, коллекций и словарей
 
Так-с, Алексей, ты чего тут своим авторитетом воду мутишь? )) Наколка на всю спину "I love Excel" есть ? )
P.S. Тоже давно слышал эту байку про несовпадении ключей-значений, но слава Богу, ни разу не попадалось )
С тех пор постоянно боюсь брать arr = Dic.Keys, arr2 = Dic.Items - уже подсознательно )) Вот запугали народ.
Наверное, кто поймает Словарь на несоответствии - озолотится )
Изменено: New - 04.07.2022 23:55:48
VBA макрос вставляет строку на основе данных из ячейки
 
Alexander Kruglov,
Код
Sub Макрос1()
    Dim LO As ListObject, i As Long, n As Long, SKU As String, ID As String

    Application.ScreenUpdating = False
    Set LO = ActiveSheet.ListObjects(1)
    With LO
        For i = .DataBodyRange.Rows.Count + 1 To 1 Step -1
            If InStr(1, .Range.Cells(i, 2), ",", vbTextCompare) > 0 Then
                SKU = .Range.Cells(i, 1)
                ID = .Range.Cells(i, 2)
                .Range.Cells(i, 1) = SKU & "-" & Split(ID, ",")(0) 'SKU
                .Range.Cells(i, 2) = Split(ID, ",")(0) 'ID
                For n = 1 To UBound(Split(ID, ","))
                    .ListRows.Add (i + n - 1)
                    .ListRows(i - 1).Range.Copy .ListRows(i + n - 1).Range
                    .Range.Cells(i + n, 1) = SKU & "-" & Split(ID, ",")(n) 'SKU
                    .Range.Cells(i + n, 2) = Split(ID, ",")(n) 'ID
                Next n
            End If
        Next i
    End With
    Application.ScreenUpdating = True
    MsgBox "Конец", vbInformation, ""
End Sub
Изменено: New - 04.07.2022 21:13:31
Замена текстовой ошибки на числовое значение 0, Замена текстовой ошибки на числовое значение 0
 
=ЕСЛИОШИБКА(ВПР(A3;'bonded stores'!$B$6:$H$50;7;0)*(B3);0)
https://support.microsoft.com/en-us/office/iferror-function-c526fd07-caeb-47b8-8bb6-63f3e417f611
P.S. Желательно прикладывать Excel файл, а не картинку
Изменено: New - 03.07.2022 17:22:14
В Excel 2016 нет Power Pivot, Как установить Power Pivot в Excel 2016
 
microsoft.com
https://www.youtube.com/watch?v=1rsmhYaPwZg
Изменено: New - 02.07.2022 22:15:26
Вывод значений на другой лист, Вывод найденной строки и следующих четырех строк за ней на другой лист
 
padre-ava, пожалуйста, не нажимайте кнопку "Цитировать", нажимайте кнопку Имя, это там же где цитировать, но правее.
У меня работает, если на Лист1 в столбец А ввести - апостроф 005. Знаете что такое апостроф? это такая запятая сверху ячейки (на английской раскладке клавиша русской буквы Э) и так же ввести апостроф 005 в ячейку А1 на листе "Лист2", то всё работает. Вывод - либо и там и там числа, либо если число начинается с 0, то и там и там вводим его через апостроф
Вывод значений на другой лист, Вывод найденной строки и следующих четырех строк за ней на другой лист
 
padre-ava, см. файл. Постарайтесь, чтобы в столбце А на "Лист1" не было текстовых цифр. Это те цифры, который вам кажутся цифрами, но для Excel это текст. Вы можете определить такие ячейки по наличию зелёного треугольничка в левом верхнем углу ячейки. Если все цифры в столбце А будут цифрами - то проблем не будет. Если вы снова скопируете в столбец А какую-то ячейку, которая имела текстовый формат и имеет зелёный треугольничек в верхнем левом углу ячейки - снова будут проблемы.
Переводите такие псевдо числа в числовой формат. То есть поменяйте формат данной ячейки с зелёным треугольничком с Текстового на Общий - и руками введите ещё раз то число, которые находится в ячейке. Тогда Excel сконвертирует данное псевдо число в реальное число и ваши формулы на Лист2 будут работать.
Изменено: New - 01.07.2022 14:26:22
Выгрузка в эксель текстовых файлов и работа с ними
 
Сделано, оплачено. Спасибо
Получение значений столбцов с нескольких листов
 
Богдан, ну, с первой задачей - собрать все заголовки со всех листов я могу помочь.
Скачайте файл, откройте его, нажмите Alt+F8 - Выполнить - макрос соберёт все уникальные заголовки со всех листов и вставит их на новый лист.
P.S. А по второй задаче - созданию сводной - если никто вам не поможет бесплатно... могу написать макрос за деньги, который соберёт вашу сводную
Изменено: New - 29.06.2022 21:36:59
Выгрузка в эксель текстовых файлов и работа с ними
 
Добрый день. Да, возможно... пишу в личку
Изменено: New - 30.06.2022 13:18:33
Получение значений столбцов с нескольких листов
 
Богдан, на форуме главное правило - приложи небольшой пример в файле Excel и покажи в нём готовый результат. Нет файла - будет долгий разговор ни о чём и впустую потерянное время
Не работает кнопка-макрос., Не работает кнопка-макрос из "элементы управления формы".
 
1. глюк
2. да
Не работает кнопка-макрос., Не работает кнопка-макрос из "элементы управления формы".
 
тааак, а где макросы? Вы знаете, что в файлах XLSX - НЕ могут быть сохранены никакие макросы?
Макросы могут быть сохранены только в файлах с расширением XLSM и XLSB (ну, и старом XLS)
Давайте я вам покажу 5-ти литровую кастрюлю с вкусным борщом... вот видите какой вкусный борщ, правда кастрюля пустая...
Изменено: New - 28.06.2022 19:15:56
Не работает кнопка-макрос., Не работает кнопка-макрос из "элементы управления формы".
 
А зачем нам ваш рабочий файл? Удалите из него все данные, оставьте только кнопку и ваш макрос. Мы скачаем, разберёмся почему у вас не работает и выложим либо рабочий файл, либо объясним что у вас не так и как исправить.
Не работает кнопка-макрос., Не работает кнопка-макрос из "элементы управления формы".
 
предлагаете нам гадать? Ну, возможно где-то идут бури, поэтому у вас что-то не работает. Нам нужен ваш файл. Все данные можете удалить из него
Изменено: New - 28.06.2022 18:23:10
Не работает кнопка-макрос., Не работает кнопка-макрос из "элементы управления формы".
 
А в чём проблема переопределить кнопки - удалить старые кнопки и создать новые, и привяжите к ним свои макросы
P.S. Попробуйте вставить на лист графическую фигуру (например, прямоугольник) и нажмите правой клавишей на ней и выберите "Назначить макрос..."
Изменено: New - 28.06.2022 18:17:28
Сведение данных из множества вкладок в один лист, Пример во вложении
 
Артур Давидов, если никто не поможет, могу написать макрос за деньги
Сведение данных из множества вкладок в один лист, Пример во вложении
 
Артур Давидов, вот если ваши реальные данные такие же идеальные как ваш приложенный пример, а именно - на всех листах услуги находятся на одних и тех же строках, а так же даты в одних и тех же столбцах, то это сделать легко. См. файл
Если же у вас услуги на всех листах написаны на разных строках (где-то услуга 1 на 2-й строке, а где-то она же на 5-й строке, а где-то на 10-й строке), а так же даты (где-то февраль в столбце D, а где-то февраль в столбце F, а где-то в K) - то уже сложнее и нужно дописывать макрос.

Код
Sub SumStages()
    Dim SvodSht As Worksheet, TempSht As Worksheet, LastRow As Long, LastCol As Long
    
    Application.ScreenUpdating = False
    Set SvodSht = Worksheets("СВОД")
    SvodSht.Cells.Clear
    Worksheets("Этап 1").Range("A1").CurrentRegion.Copy SvodSht.Range("A1")
    With SvodSht
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    End With
    For Each TempSht In Worksheets
        If TempSht.Name <> "Этап 1" And TempSht.Name <> SvodSht.Name Then
            With TempSht
                .Range("C2", .Cells(LastRow - 1, LastCol)).Copy
            End With
            SvodSht.Range("C2").PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks:=False, Transpose:=False
        End If
    Next TempSht
    SvodSht.Activate
    SvodSht.Range("A1").Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "Данные просуммированы!", vbInformation, "Конец"
End Sub
Изменено: New - 25.06.2022 12:20:19
Вставка диапазона с отфильтрованными (скрытыми) строками
 
можно в панель быстрого доступа добавить кнопку "Выделить видимые ячейки (Alt + ;)" - и если её нажимать перед Ctr+C, то у вас копироваться будут только видимые ячейки. Либо попробуйте так
1. Выделяете нужные ячейки
2. Alt + ;
3. Ctrl+C (это копирование)
4. Вставка копирования куда хотите (Ctrl+V)
Изменено: New - 26.06.2022 03:22:48
Помощь с расчетом долей в таблице.
 
=СЧЁТЕСЛИ($A$1:$A$3000;"<"&10000) / СЧЁТЗ($A$1:$A$3000)
=СЧЁТЕСЛИМН($A$1:$A$3000;">="&10000;$A$1:$A$3000;"<" & 20000) / СЧЁТЗ($A$1:$A$3000)
и т.д.
Разделить таблицу на файлы
 
Тимофеев,
Код
Sub Split_Table_To_Files()
    Dim arrData, Dict As Object, i As Long, LO As ListObject, wsSheetData As Worksheet
    Dim sDepartment As String, vKey As Variant, lCounter As Long, Rng As Range
    
    If MsgBox("Split the table into separate files by departments?", vbQuestion + vbYesNo, "Question") = vbNo Then Exit Sub
    
    Set wsSheetData = ActiveSheet
    On Error Resume Next
    Set LO = wsSheetData.ListObjects("Table1")
    On Error GoTo 0
    
    If LO Is Nothing Then
        MsgBox "There is no 'Table1' on the active sheet!", vbExclamation, "Error"
        Exit Sub
    End If
    
    LO.AutoFilter.ShowAllData
    arrData = LO.Range.Value
    
    Set Dict = CreateObject("Scripting.Dictionary")
    
    For i = 2 To UBound(arrData)
        sDepartment = arrData(i, 1)
        If sDepartment <> "Total" Then
            If Not Dict.Exists(sDepartment) Then Dict(sDepartment) = 0&
        End If
    Next i
    
    If Dict.Count = 0 Then
        MsgBox "It was not possible to collect the unique names of the departments!", vbExclamation, "Error"
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error GoTo errHandler:
     
    For Each vKey In Dict.Keys
        ActiveSheet.Copy
        Set LO = ActiveSheet.ListObjects(1)
        With LO
            .AutoFilter.ShowAllData
            .Range.AutoFilter Field:=1, Criteria1:="<>" & vKey
            '-2 - это оставляем строку Итогов
            Set Rng = .AutoFilter.Range.Offset(1, 0).Resize(.AutoFilter.Range.Rows.Count - 2, .AutoFilter.Range.Columns.Count).SpecialCells(xlCellTypeVisible)
            Rng.Delete
            .AutoFilter.ShowAllData
        End With
        
        With ActiveSheet
            .Columns(1).ColumnWidth = 40
            .Range("A1").Select
            .Cells.Locked = True
            .Columns("H:H").Locked = False
            .Columns("K:M").Locked = False
            .Protect Password:="2106", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingColumns:=True, AllowSorting:=True, AllowFiltering:=True
        End With
        ActiveWindow.LargeScroll Down:=-1000
        If Dir(ThisWorkbook.Path & Application.PathSeparator & vKey & ".xlsx") <> "" Then
            Kill ThisWorkbook.Path & Application.PathSeparator & vKey & ".xlsx"
        End If
        ActiveWorkbook.SaveAs ThisWorkbook.Path & Application.PathSeparator & vKey & ".xlsx", xlOpenXMLWorkbook, CreateBackup:=False
        ActiveWorkbook.Close (False)
        lCounter = lCounter + 1
    Next vKey
 
errHandler:
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Created " & lCounter & " files!", vbInformation, "Finish"
End Sub
Изменено: New - 22.06.2022 13:20:57
Разделить таблицу на файлы
 
Артур Горохов, если никто не поможет, готов платно написать вам макрос. Будет всё работать, кроме возможности Сортировки на защищённом листе.
Договорились с автором, отправил ему макрос
Изменено: New - 21.06.2022 22:34:27
выбор в комбобоксах из списка в палитре цвета
 
может это поможет https://www.youtube.com/watch?v=WUOwUlO8VbQ
Макрос для копирования листа с одной книги в другую, Копирование листа с одной книги в другую
 
Код
Private Sub CopySheetsToWB1_Click()
    Dim wb As Workbook
    'Me.TextBox1.Text = "Книга122.xlsx"
    If InStr(1, Me.TextBox1.Text, ".", vbTextCompare) = 0 Then
        MsgBox "Какого хрена не указал расширение файла (.XLSX)?", vbExclamation, "Будь внимательнее!!!"
        Exit Sub
    End If
    On Error Resume Next
    Set wb = Workbooks(Me.TextBox1.Text)
    On Error GoTo 0
    If wb Is Nothing Then
        MsgBox "Нет такого окрытого файла: " & Me.TextBox1.Text, vbExclamation, "Будь внимательнее!!!"
        Exit Sub
    End If
    ThisWorkbook.Sheets(1).Copy After:=wb.Sheets(1)
    MsgBox "Лист скопирован!", vbInformation, "Копирование листа"
End Sub
Изменено: New - 20.06.2022 22:21:53
Макрос выпадающего списка со скрытыми листами, Как сделать раскрывающий список с использованием скрытых листов
 
Цитата
artemkau88 написал:
Worksheets(ComboBox1.Value).Visible = Афдыу
лучше писать False вместо Афдыу
P.S. Хитрец, уже исправил )
Изменено: New - 20.06.2022 18:42:24
Список уникальных значений с разных листов одного файла
 
Sergeyk, вам пытаются объяснить, что не нужно нажимать на кнопку "Цитировать" - если вы не хотите из длинного текста акцентировать внимание на её небольшой части. А вместо этого желательно нажимать кнопку "Имя", да, такая кнопка есть и она находится на 1 сантиметр правее кнопки "Цитировать" и желательно нажимать её, если вы хотите обратиться к конкретному человеку. Т.е. просто забудьте про кнопку "Цитировать" и откройте для себя кнопку "Имя"
Замена дубликатов другими значениями, Замена дубликатов на null
 
Вы бы в название темы или в описании задания указали бы, что решение нужно в PQ (обычно так сокращают Power Query)
Создания ведомость предметов
 
У автора бюджет 500руб. Я пас.
Список уникальных значений с разных листов одного файла
 
1) руками
2) макрос
3) Power Query
Изменено: New - 20.06.2022 15:52:06
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 120 След.
Наверх