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

Страницы: 1 2 След.
Макрос из VBA в Lua, Переработать макрос из VBA в Lua
 
Здравствуйте! Прошу помочь с переработкой макроса для рабочей деятельности под Luo, так как с этим языком не знаком. Спасибо за помощь! Прикрепляю макрос в документах.
Изменено: gefy 444 - 28.03.2023 12:16:52
Помощь в улучшении макроса, Комбинирование в один макрос из нескольких
 
Здравствуйте. Прошу подсказать в улучшении (упрощении) макроса, использую его для переворота таблиц.
В чем суть переворота:
1) В каждую таблицу добавляется столбец с помощью одного из макросов,  куда в дальнейшем переносится название листа и протягивается на всю длину столбца где есть данные (листов в документах от 60 до 90 -  каждый документ по разному)
2) А затем происходит переворот другим макросом
В примере привел пример, как выглядит исходник, потом после добавление столбца и в итоговом виде.
Примечание:1) Количество строк в каждом листе отличается от 2 до 20 (это примерно) - каждый раз по разному
2) Количество листов тоже меняется в каждом документе
3) Шапка всегда тоже меняется, все зависит от базы (поэтому макрос при перевороте спрашивает сколько столбцов и строк нужно)
Буду благодарен любой помощи!
Редизайн таблицы с данными, Перестроить таблицу с данными под условия
 
memo, понял, спасибо, попробую такой вариант
Редизайн таблицы с данными, Перестроить таблицу с данными под условия
 
memo, а можешь прислать свой код, то он у меня выделяет весь красный в VBA?
Сохранение формата ячеек, Сохранить формат ячеек после использования макроса
 
Msi2102, тоже как вариант хороший, подходит
Спасибо большое за помощь!
Макрос для редизайнера на все страницы файла, Прошу помочь с кодом для редизайна таблиц для всего файла
 
Msi2102, понял, учту такой вариант, спасибо большое
Макрос подошел, в обоих случаях, спасибо за помощь еще раз
Перенос названия листа в таблицу и редизайн самой таблицы под условия, Прошу помочь как переделать макрос под условия
 
memo, Хорошо учту в дальнейшем, спасибо.
Перенос названия листа в таблицу и редизайн самой таблицы под условия, Прошу помочь как переделать макрос под условия
 
memo, можно, там я написал во многих, что подходит и поблагодарил за помощь, значит тема закрыта, если я что то не так сделал, прошу подправить меня.
Перенос названия листа в таблицу и редизайн самой таблицы под условия, Прошу помочь как переделать макрос под условия
 
Приветствую, прошу помочь с решением проблемы с макросом.
Условие: есть таблица на 100 листов ( примерно), каждый лист имеет свой код уникальный (название листа) и каждый лист по структуре одинаковый, только данные внутри таблицы разные.
Нужно:
  1. Сделать редизайн таблицы, как приведено в примере, всех листов
  2. Перенести номер листа в таблицу в столбец и протянуть на всю длину таблицы
Привожу мой код, он только переносит один столбец, а второй удаляет....
Спасибо большое за помощь!
Код
Sub НазваниеЛистаНаЛист()

    Dim sh As Worksheet

    For Each sh In ActiveWorkbook.Worksheets

        JobSheet sh

    Next

End Sub

Sub JobSheet(sh As Worksheet)

    With sh

        Dim yy As Long

        yy = .Cells(.Rows.Count, 1).End(xlUp).Row

        If yy >
4 Then

            .Range(.Cells(5, 3), .Cells(yy, 4)).Value
= Array(.Range("B3").Value, .Name)

            .Rows("1:4").Delete Shift:=xlUp

        End If

    End With

End Sub
Редизайн таблицы с данными, Перестроить таблицу с данными под условия
 
Здравствуйте, прошу подсказать в ситуации, есть таблицы с исходными данными, но она сформирована в сплошном формате (где категории и их элементы отображены в одном столбце), прошу подсказать макрос, который может перенести название категорий в отдельный столбец и протянуть до названия следующей категории?(пример прикреплен), элементов внутри каждой категории 94, мб поможет (1 строка название категории, последующие 94 элементы ее, затем  96 строка - название категории И так далее)Спасибо большое!
Макрос для редизайнера на все страницы файла, Прошу помочь с кодом для редизайна таблиц для всего файла
 
Msi2102, вот все отлично, как надо, но можно убрать привязку к названиям листов?
Макрос для редизайнера на все страницы файла, Прошу помочь с кодом для редизайна таблиц для всего файла
 
Код
    Sub example1()

    Dim inpdata As Range, realdata As Range, ns As Worksheet
    Dim i&, j&, k&, c&, r&, hc&, hr&
    Dim out() As String, dataArr, hcArr, hrArr
    Dim x As Worksheet

    Set inpdata = ThisWorkbook.Application.InputBox( _
   prompt:="Выберите обрабатываемый диапазон:", Title:="Выбор диапазона", Type:=8)
    
   hr = Val(InputBox("Сколько строк с подписями сверху?"))
   hc = Val(InputBox("Сколько столбцов с подписями слева?"))
   
   For Each x In ThisWorkbook.Worksheets()
    
    If inpdata.Rows.Count <= hr Or inpdata.Columns.Count <= hc Then Exit Sub
    Set realdata = inpdata.Offset(hr, hc).Resize(inpdata.Rows.Count - hr, inpdata.Columns.Count - hc)
    dataArr = realdata.Value
    If hr Then hrArr = inpdata.Offset(0, hc).Resize(hr, inpdata.Columns.Count - hc).Value
    If hc Then hcArr = inpdata.Offset(hr, 0).Resize(inpdata.Rows.Count - hr, hc).Value
    
    ReDim out(1 To Application.CountA(realdata), 1 To hr + hc + 1)
    Set ns = Worksheets.Add
    
    For i = 1 To UBound(dataArr, 1)
        For j = 1 To UBound(dataArr, 2)
            If Not IsEmpty(dataArr(i, j)) Then
                k = k + 1
                For c = 1 To hc: out(k, c) = hcArr(i, c): Next c
                For r = 1 To hr: out(k, c + r - 1) = hrArr(r, j): Next r
                out(k, c + r - 1) = dataArr(i, j)
            End If
    Next j, i
    ns.Cells(2, 1).Resize(UBound(out, 1), UBound(out, 2)) = out
Next x
End Sub

Подправил макрос, но он не хочет на все листы использоваться, выдает ошибку, в чем ошибка в коде?
Макрос для выполнение нужного макроса на всех листах файлах, Помочь с решением с кодом по макросу, который будет выполнять макрос на всех листах файла
 
sokol92, Удалил. Жалко, что для простых. Прост от макроса нужно, чтоб отработал на 1 листе под требуемые условия (которые задаются: размер таблицы, строки и столбцы), и по данным условиям дальше отработал по остальным листам  
Макрос для редизайнера на все страницы файла, Прошу помочь с кодом для редизайна таблиц для всего файла
 
Msi2102, на каждой листе форма данных одинаковая, по идее должно быть так: на 1 листе использовать макрос - выбрать диапазон данных, затем строки и столбцы соответственно, макрос отработал редизайн листа и затем чтобы данный редизайн  (условиям по макросу) были применены на следующие листы
Без. сливания в один лист.
Изменено: gefy 444 - 27.05.2022 15:34:59
Макрос для редизайнера на все страницы файла, Прошу помочь с кодом для редизайна таблиц для всего файла
 
New, Msi2102, да на одном листе он работает, но я хотел бы, чтоб на всех отработал так от одного запуска макросом
Макрос для выполнение нужного макроса на всех листах файлах, Помочь с решением с кодом по макросу, который будет выполнять макрос на всех листах файла
 
sokol92, можете подсказать, как в ваш макрос можно вписать мой, чтоб они вместе функционировали? Вместо Planeta как то вставить макрос или как
Код
Sub Test()
  ActiveCell.Formula = "Planeta"
End Sub
Макрос для выполнение нужного макроса на всех листах файлах, Помочь с решением с кодом по макросу, который будет выполнять макрос на всех листах файла
 
Неплохая идея, а как вот теперь, пусть даже если с выделением листов, запустить макрос нужный.
Изменено: gefy 444 - 27.05.2022 15:25:43
Макрос для редизайнера на все страницы файла, Прошу помочь с кодом для редизайна таблиц для всего файла
 
Цитата
написал:
Может выбираете не правильно?- Выбрать область это нужно мышкой на листе выделить вашу таблицуУ меня отработало без ошибок
макрос на 1 листе работает, я знаю. но я хотел бы, чтобы он отработал так на всех листах от одного запуска макроса.
Макрос для редизайнера на все страницы файла, Прошу помочь с кодом для редизайна таблиц для всего файла
 
Цитата
написал:
я запустил ваш макрос из файла на листе "Было", выбрал весь диапазон таблицы мышкой и два раза указал цифру 1 - создался лист и он заполнился данными. Макрос отработал без ошибок. Мне сейчас не понятно, где у вас происходит ошибка. Макрос работает
макрос на 1 листе работает, я знаю. но я хотел бы, чтобы он отработал так на всех листах от одного запуска макроса.
Макрос для редизайнера на все страницы файла, Прошу помочь с кодом для редизайна таблиц для всего файла
 
New, подправил, спасибо за заметку
Макрос для редизайнера на все страницы файла, Прошу помочь с кодом для редизайна таблиц для всего файла
 
Цитата
написал:
gefy 444 , без файла сложно понять в чем ошибка, потому что не понятно, где и как расположены данные изначально, их формат и т.п.
Вот пример  
Макрос для редизайнера на все страницы файла, Прошу помочь с кодом для редизайна таблиц для всего файла
 
Здравствуйте! Есть файл с небольшим количеством листов (10 примерно), у меня есть макрос, только выдает ошибку при запуске.В чем суть макроса, требуется произвести редизайна на всех листах файлах (условия редизайна одинаковы для всех листов). Условия задаются уже в макросе (выбрать область (область, количество строк сверху, столбцов слева). В чем ошибка? Буду благодарен, если так же подскажите как дописать, чтобы область он определял по кол-ву заполненный полей 1 строки и 1 столбца.
Код
Sub Redesigner()
    Dim inpdata As Range, realdata As Range, ns As Worksheet
    Dim i&, j&, k&, c&, r&, hc&, hr&
    Dim out() As String, dataArr, hcArr, hrArr
    
    For Each ws In Worksheets
  With ws
     Set inpdata = ThisWorkbook.Application.InputBox( _
   prompt:="¬ыберите обрабатываемый диапазон:", Title:="¬ыбор диапазона", Type:=8)
    
   hr = Val(InputBox("—колько строк с подпис€ми сверху?"))
   hc = Val(InputBox("—колько столбцов с подпис€ми слева?"))

   
    If inpdata.Rows.Count <= hr Or inpdata.Columns.Count <= hc Then Exit Sub
    Set realdata = inpdata.Offset(hr, hc).Resize(inpdata.Rows.Count - hr, inpdata.Columns.Count - hc)
    dataArr = realdata.Value
    If hr Then hrArr = inpdata.Offset(0, hc).Resize(hr, inpdata.Columns.Count - hc).Value
    If hc Then hcArr = inpdata.Offset(hr, 0).Resize(inpdata.Rows.Count - hr, hc).Value
    
    ReDim out(1 To Application.CountA(realdata), 1 To hr + hc + 1)
    Set ns = Worksheets.Add
    
    For i = 1 To UBound(dataArr, 1)
        For j = 1 To UBound(dataArr, 2)
            If Not IsEmpty(dataArr(i, j)) Then
                k = k + 1
                For c = 1 To hc: out(k, c) = hcArr(i, c): Next c
                For r = 1 To hr: out(k, c + r - 1) = hrArr(r, j): Next r
                out(k, c + r - 1) = dataArr(i, j)
            End If
    Next j, i
    ns.Cells(2, 1).Resize(UBound(out, 1), UBound(out, 2)) = out
    End with ws
    Next ws
End Sub


Изменено: gefy 444 - 27.05.2022 14:23:52
Макрос для выполнение нужного макроса на всех листах файлах, Помочь с решением с кодом по макросу, который будет выполнять макрос на всех листах файла
 
Цитата
написал:
Код ? 12345678910111213141516'можно добавить цикл пробега по всем листам 'минимально изменяя ваш макрос можно как-то так:For each ws in activebook.worksheetsws.activateWith ActiveSheet        Set Rng = .Columns(3).Find(FindWord, , xlFormulas, xlWhole) 'xlWhole -ячейка целиком (xlPart - часть ячейки)        If Rng Is Nothing Then            MsgBox "Слово '" & FindWord & "' не найдено в 3-м столбце!", vbExclamation, "Внимание"            Exit Sub        End If        firstAddres = Rng.Address        Do            .Rows(Rng.Row).Copy            .Rows(Rng.Row + 1).Insert Shift:=xlDown            .Cells(Rng.Row + 1, 3) = ReplaceWord            Set Rng = .Columns(3).FindNext(Rng)        Loop Until Rng.Address = firstAddres    End With    Next


Кому решение нужно - тот пример и рисует.
Я попытался сделать что то похожее с другим запросом, но тут ошибка. В чем я ошибся? Выше исписанный запрос, не подошел под требования, которые мне надо в таблице сделать.
Макрос для выполнение нужного макроса на всех листах файлах, Помочь с решением с кодом по макросу, который будет выполнять макрос на всех листах файла
 
Цитата
написал:
Насколько я знаю, "на всех листах сразу" - так нельзя. Это примерно как ехать на автомобиле одновременно на работу, в отпуск к морю, в магазин за новым креслом и на рынок за мангалом.Сначала одно, потом другое. Сначала один объект (лист), потом другой.Насколько я знаю.
Это да, пусть последовательно. Просто сам факт, чтобы макрос проделывал все, не приходилось в ручную каждый лист запускать макрос.
Макрос для выполнение нужного макроса на всех листах файлах, Помочь с решением с кодом по макросу, который будет выполнять макрос на всех листах файла
 
Цитата
написал:
и что ваш макрос должен делать? не считая прохода по листам.Ваш только проверяет имя листа и ничего не делает.П.С. Имя листа не может быть пустыОбщ
Общая идея, чтобы макрос выполнялся на всех листа сразу, а не проходить по каждому из них. Вот хотел модернизировать.
Макрос для выполнение нужного макроса на всех листах файлах, Помочь с решением с кодом по макросу, который будет выполнять макрос на всех листах файла
 
Здравствуйте, не поможете, есть макрос для редизайна таблицы, но в Ексель около 10-15 листов, не получается написать макрос, чтоб мой макрос выполнялся на всех листах. Буду благодарен за помощь. (макрос, который я пытался сделать для выполнения на всех листах)
Код
for I=1 to sheets.count
if worksheets(i).name<> ""then

end if
next I
Изменено: gefy 444 - 27.05.2022 13:32:02
Сохранение формата ячеек, Сохранить формат ячеек после использования макроса
 
Здравствуйте! прошу подсказать, как дописать макрос, чтобы после использования его не менялся формат ячеек? То после использование ячейки меняют формат либо знаки в самой ячейке, к примеру, изначально была ячейка "12.2" после использования макроса формат ячейки стал "12,2" либо "12 янв." Прикрепляю код и пример:
Код
Sub Redesigner()    
Dim inpdata As Range, realdata As Range, ns As Worksheet    
Dim i&, j&, k&, c&, r&, hc&, hr&    
Dim out(), dataArr, hcArr, hrArr        
Set inpdata = ThisWorkbook.Application.InputBox( _   prompt:="Выберите обрабатываемый диапазон:", Title:="Выбор диапазона", Type:=8)       
hr = Val(InputBox("Сколько строк с подписями сверху?"))   
hc = Val(InputBox("Сколько столбцов с подписями слева?"))       
If inpdata.Rows.Count <= hr Or inpdata.Columns.Count <= hc Then Exit Sub    
Set realdata = inpdata.Offset(hr, hc).Resize(inpdata.Rows.Count - hr, inpdata.Columns.Count - hc)    
dataArr = realdata.Value    If hr Then hrArr = inpdata.Offset(0, hc).Resize(hr, inpdata.Columns.Count - hc).Value    
If hc Then hcArr = inpdata.Offset(hr, 0).Resize(inpdata.Rows.Count - hr, hc).Value        
ReDim out(1 To Application.CountA(realdata), 1 To hr + hc + 1)    
Set ns = Worksheets.Add        
For i = 1 To UBound(dataArr, 1)        
For j = 1 To UBound(dataArr, 2)            
If Not IsEmpty(dataArr(i, j)) Then                
k = k + 1                
For c = 1 To hc: out(k, c) = hcArr(i, c): Next c                
For r = 1 To hr: out(k, c + r - 1) = hrArr(r, j): Next r                
out(k, c + r - 1) = dataArr(i, j)            
End If    Next j, I    
ns.Cells(2, 1).Resize(UBound(out, 1), 
UBound(out, 2)) = out
End Sub
Изменено: gefy 444 - 26.05.2022 15:43:35
Дублирование строки под нужное условие, Производит дублирование всей строки, находит под условие
 
Цитата
написал:
Sub Дублирование_строки()    Dim FindWord As String, ReplaceWord As String, Rng As Range, firstAddres As String         FindWord = Application.InputBox("Какое слово найти в 3-м столбце?", "Поиск слова")    If FindWord = Empty Then Exit Sub    ReplaceWord = Application.InputBox("На какое слово заменить?", "Поиск слова")    If ReplaceWord = Empty Then Exit Sub         With ActiveSheet        Set Rng = .Columns(3).Find(FindWord, , xlFormulas, xlWhole) 'xlWhole -ячейка целиком (xlPart - часть ячейки)        If Rng Is Nothing Then            MsgBox "Слово '" & FindWord & "' не найдено в 3-м столбце!", vbExclamation, "Внимание"            Exit Sub        End If        firstAddres = Rng.Address        Do            .Rows(Rng.Row).Copy            .Rows(Rng.Row + 1).Insert Shift:=xlDown            .Cells(Rng.Row + 1, 3) = ReplaceWord            Set Rng = .Columns(3).FindNext(Rng)        Loop Until Rng.Address = firstAddres    End With    MsgBox "Сделано!", vbInformation, "Конец"End Sub
Ого, отлично! Спасибо большое за помощь!
Дублирование строки под нужное условие, Производит дублирование всей строки, находит под условие
 
Здравствуйте! Прошу подсказать, как можно решить такой вопрос. Подскажите с макросом, который будет делать следующие шаги:-Находит нужную строку (строки) в массиве данных по определённому слову
- Дублирует данную строку полностью (строки)
- Переименовывает слово (по которому был сделан поиск) на требуемое (задается пользователем)
На примере прикрепляю файл:
Таблица с "было" и "стало", где был сделан поиск по слову "1 кв", далее строки были продублированы и переименованы на "1 кв.н".
Спасибо большое за помощь заранее!
Смещение строк в столбец (как продолжение строки) под динамическое количество строк, Макрос для смещение строк в столбец, чтоб была группировки от названия столбца
 
Цитата
написал:
протяните вправо на одну ячейку и вниз до конца таблицыустановите фильтр и отсортируйте по столбцу С (Прибыль) пустые ячейкиМожете скопировать полученные два столбца и вставить только значения, после чего тот же фильтр, только выделить только пустые ячейки и удалить эти строки.
Хитрый ход))) Спасибо за помощь!
Страницы: 1 2 След.
Наверх