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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 104 След.
Как активировать окно эксель с частично известным названием файла., Макрос для активизации окна
 
книга с запущенным макросом это всегда ThisWorkbook, таким образом

Код
    Workbooks.Open Filename:=ThisWorkbook.Path & "\Kalibrov_Grafik.xlsm" 
    Sheets("Indleather").Select
    Range("G3").Copy
    ThisWorkbook.Activate
    Range("G3").Select
Изменено: New - 27.11.2021 07:44:19
Некоторые сохраненные макросом формулы в значения выдают ошибку #знач после запуска макроса.
 
Цитата
Артем_81 написал:
Кто знает что за нюансы у макросов с работой с этим типом формул?
Ограничение в 255 символов
Cобрать данные из столбца в строку
 
Соглашусь
Cобрать данные из столбца в строку
 
venrt, попробуйте так

Код
Sub FillTable()
    Dim arrData As Variant, Dict As Object, arrOut As Variant, i As Long, iKey As Variant, iCol As Long
    Dim arrData2 As Variant, LastRow As Long, n As Long
    
    arrData = Worksheets("Табл2").Range("A1").CurrentRegion
    Set Dict = CreateObject("Scripting.Dictionary")
        
    For i = 2 To UBound(arrData)
        If Not Dict.Exists(arrData(i, 1)) Then
            Set Dict.Item(arrData(i, 1)) = CreateObject("Scripting.Dictionary")
            Dict.Item(arrData(i, 1)).Item(arrData(i, 2)) = arrData(i, 3)
        Else
            Dict.Item(arrData(i, 1)).Item(arrData(i, 2)) = Dict.Item(arrData(i, 1)).Item(arrData(i, 2)) + arrData(i, 3)
        End If
    Next i
        
    With Worksheets("Табл1")
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        arrData2 = .Range("A3:A" & LastRow).Value
    End With
    
    i = 0
    ReDim arrOut(1 To Dict.Count, 1 To 5) 'не знаем вторую размерность массива, иначе надо подключить библиотеку Dictionary
    
    For n = 1 To UBound(arrData2, 1)
        i = i + 1
        iCol = 0
        For Each iKey In Dict.Item(arrData2(n, 1)).Keys
            iCol = iCol + 1
            arrOut(i, iCol) = Dict.Item(arrData2(n, 1)).Item(iKey)
        Next iKey
    Next n
    
    Worksheets("Табл1").Range("C3").Resize(UBound(arrOut, 1), UBound(arrOut, 2)).Value2 = arrOut
    MsgBox "Сделано!", vbInformation, ""
End Sub
Изменено: New - 26.11.2021 12:29:47
Cобрать данные из столбца в строку
 
Евгений Смирнов, код отличный, только плохо, что выгрузка результата на лист идёт построчно. Если строк в таблице будет много (скажем сотни тысяч), то выгрузка может затянуться... Переложить бы результаты в двумерный массив и одной строкой выгрузить в С3...
Изменено: New - 26.11.2021 11:33:27
Cобрать данные из столбца в строку
 
или вы всё же макрос хотите?
Вставка в ячейки на Лист2 диапазоном с TextBox, Вставка в ячейки на Лист2 диапазоном с TextBox
 
Либо каждой ячейки присваивать значение, либо через массив. Но одной строку не получится
Изменено: New - 26.11.2021 08:25:28
Вставка в ячейки на Лист2 диапазоном с TextBox, Вставка в ячейки на Лист2 диапазоном с TextBox
 
Код
Private Sub CommandButton1_Click()
Dim arr As Variant

    ReDim arr(1 To 1, 1 To 4)
    arr(1, 1) = TextBox2.Value
    arr(1, 2) = TextBox3.Value
    arr(1, 3) = TextBox4.Value
    arr(1, 4) = TextBox5.Value

    With Sheets("Лист2")
        .[D9:G9] = arr
    End With
End Sub


Возможная тема: Вставить данные из 4х TextBox на лист одной строкой
УМЕНЬШЕНИЕ шрифта в определёнен строках
 
Aleksejs Bogdanovs, Если вам надо на всех листах значение ПОСЛЕДНЕГО Итого в столбце F выделить жирным и поставить по центру, то так (почитайте зелёные комментарии)

Код
Sub Test()
    Dim i As Long, LastRow As Long
    
    'цикл по всем листам в активной книге
    For i = 1 To ActiveWorkbook.Worksheets.Count
        'с очередным листом делаем (от 1 до кол-ва листов в файле)
        With ActiveWorkbook.Worksheets(i)
            'ищем последнюю заполненную строку в столбце F
            LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
            'проверяем, что в столбце С написано слово "Итог", тогда делаем ниже
            If .Cells(LastRow, "C") = "Итог" Then
                'делаем шрифт жирным
                .Cells(LastRow, "F").Font.Bold = True
                'выравниваем значение ячейки по горизонтали
                .Cells(LastRow, "F").HorizontalAlignment = xlCenter
            End If
        End With
    Next i
    MsgBox "Конец", vbInformation, ""
End Sub


Если же вам нужно сделать все цифры Итого жирными и выравнять их по центру (а не только последнего Итог), то вот так  (почитайте зелёные комментарии)

Код
Sub Test2()
    Dim i As Long, Rng As Range, firstAddress As String
    
    'цикл по всем листам в активной книге
    For i = 1 To ActiveWorkbook.Worksheets.Count
        'с очередным листом делаем (от 1 до кол-ва листов в файле)
        With ActiveWorkbook.Worksheets(i)
            'производим поиск слова "Итог" в столбце С (3-й столбец)
            Set Rng = .Columns(3).Find("Итог", , xlFormulas, xlWhole)
            'если где-то нашли слово "Итог", то
            If Not Rng Is Nothing Then
                'запоминаем адрес ячейки первого найденного слова "Итог"
                firstAddress = Rng.Address
                'начало цикла поиска
                Do
                    'делаем шрифт жирным в столбце F найденного значени Итог
                    .Cells(Rng.Row, "F").Font.Bold = True
                    'выравниваем значение ячейки по горизонтали
                    .Cells(Rng.Row, "F").HorizontalAlignment = xlCenter
                    'производим следующий поиск слова "Итог" в столбце С (3-й столбец)
                    Set Rng = .Columns(3).FindNext(Rng)
                    'производим цикл поиска по столбцу "С" пока поиск не приведёт нас к первой найденной ячейки Итог
                Loop Until Rng.Address = firstAddress
            End If
        End With
    Next i 'переходим к другому листу
    MsgBox "Конец", vbInformation, ""
End Sub
Изменено: New - 26.11.2021 11:21:54
Cобрать данные из столбца в строку
 
venrt, я вот тут подумал... а вам формула не подойдёт?
Вставьте эту формулу в ячейку С3 и протяните вправо и вниз до конца таблицы
=СУММЕСЛИМН(Табл2!$C:$C;Табл2!$A:$A;$A3;Табл2!$B:$B;C$2)
См. файл
Изменено: New - 26.11.2021 01:33:29
Объединить столбцы в один столбец.
 
прочитайте ещё раз сообщение #2 в этой теме. Если не очень поняли, то прочитайте его ещё раз... и т.д. пока не поймёте, что мы, когда помогает людям на форуме, стараемся не брать данные из головы, а берём пример от ТС и под его конкретный пример пишем макрос.
P.S. Вам понравится поднять 5 мешков картошки на 5-й этаж, а потом вам скажут - ой, а это не тот подъезд, спускай все мешки обратно вниз и поднимай в другом подъезде. Вы думаете, если вашу задачу можно решить с помощью макроса, то мы пишем макросы за 1 минуту и это очень легко? Я сейчас напишу макрос за полчаса на СВОИХ ПРИДУМАННЫХ ДАННЫХ, выложу сюда его вам, вы протестируете на своих данных и скажите - ааа, нее, надо не так, у меня данные в моём файле не так находятся и результат мне нужен через запятую, а не так как вы сделали - идите переделывайте. И мне надо будет опять тратить полчаса своего времени, чтобы уже под ваш пример переделать макрос. Спасибо, мне так не надо. Я лучше другому пойду помогу в соседней теме, кто приложил файл-пример и показал какие данные есть и какой результат нужен в конце после обработки данных.
Если бы вы приложили небольшой файл-пример к вашему первому сообщению (не вашу рабочую книгу, а небольшой файл-пример), то вы бы уже получили решение по вашему вопросу. Но вы решили углубиться в описательную часть вашего повествования.
См. ниже файл с макросом

P.S. Свои сообщения на форуме можно корректировать и дополнять, а не создавать одно за одним новое сообщение. Под каждым вашим сообщением внизу справа есть кнопка "Изменить" - можно нажать и дополнить ваше сообщение новыми мыслями
Изменено: New - 26.11.2021 02:04:47
Запуск макросом сторонней программы, с вводом пароля
 
а ты молодец! Только я бы добавил защиту от бесконечного цикла, а то программа не откроется, либо заголовок окна будет другим - и программа зависнет в бесконечном цикле. Предлагаю такой вариант

Код
#If Win64 Then
Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
#Else
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If
 
Sub StarProgramAndInputPassword()
    Dim Hwnd As LongPtr, MyWinID As String, Password As String, ProgramPath As String, ExitTime As Double
       
    'путь к программе
    ProgramPath = "C:\Program Files\Microsoft Office\root\Office16\WINWORD.EXE"
    'Указываем заголовок окна программы
    MyWinID = ("Документ1 - Word")
    'Указываем пароль
    Password = ".password"
    
    'Запускаем программу
    Shell ProgramPath, 1 '1 = vbNormalFocus
    'Shell "explorer.exe C:\*.lnk", 1 '1 = vbNormalFocus
    'Ищем handler окна программы
    Hwnd = FindWindow(vbNullString, MyWinID)
    'защита от бесконечного цикла 20 секунд
    ExitTime = Now + TimeValue("0:00:20")
    'Выполняем поиск окна пока оно не найдено
    Do While (Hwnd = 0)
        Hwnd = FindWindow(vbNullString, MyWinID)
        If Hwnd <> 0 Then Exit Do
        If Now >= ExitTime Then Exit Sub
    Loop
    'Активируем найденное окно и вводим пароль, при условии что логин уже введен
    Application.Wait Time:=Now + TimeValue("0:00:01")
    On Error Resume Next
    AppActivate MyWinID
    On Error GoTo 0
    If Err <> 0 Then
        Err.Clear
        Exit Sub
    End If
    SendKeys "{TAB}"
    SendKeys Password
    SendKeys "{ENTER}"
End Sub
Изменено: New - 26.11.2021 00:15:28
Cобрать данные из столбца в строку
 
может просто из плоской построить руками Сводную таблицу?
P.S. А так как обычно - макросом.
Изменено: New - 26.11.2021 00:34:18
Макрос для нахождения значений и удаление соседних значений
 
Сестра, файл... (В нем что есть и что надо получить)
Изменено: New - 25.11.2021 22:41:34
Объединить столбцы в один столбец.
 
Ужасть) задача одна, код вообще левый, но для ТС подошло))
Как Условное форматирование может объединять данные из разных столбцов в один?
Изменено: New - 25.11.2021 22:47:49
Прописание проверочных условий в коде макроса
 
Придумайте более корректное название для вашей темы, которое будет отражать вашу задачу, напишите его в своем сообщении и модератор заменит название темы и мы будем дальше думать над вашим кодом
Дублирование фраз по указанному количеству раз
 
Пожалуйста, не забывайте в следующий раз прикладывать небольшой файл-пример к своему вопросу, а не описывать таблицу словами в сообщении
Объединить столбцы в один столбец.
 
например, макросом. Но от вас нужен небольшой файл-пример (и в нём же желательно показать итоговый результат, можно на соседнем листе)
Изменено: New - 25.11.2021 21:54:07
Дублирование фраз по указанному количеству раз
 
Макрос, см. файл
Прописание проверочных условий в коде макроса
 
Проверять-то можно, но я бы так не делал. Вот код. Обратите внимание на точки перед Range, они ставятся обязательно у объектов Range и Cells внутри блока With ... End With

Код
    With Worksheets("Форма")
        If .Range("B2").Value <> .Range("B8").Value Then
            MsgBox "Ячейки B2 и B8 не равны!", vbExclamation, "Внимание"
            Exit Sub
        End If
    End With
Прописание проверочных условий в коде макроса
 
вам надо научиться пользоваться методом Find в своих макросах. Find - это поиск, которым вы пользуетесь, когда нажимаете Ctrl+F на листе Excel
почитайте комментарии зелёным цветом

Код
Dim Rng As Range, LastRow As Long, CustomerName As String

    With Worksheets("Форма") 'работаем с листом Форма
        CustomerName = .Range("B2") 'имя клиента из ячейки В2
        If CustomerName = vbNullString Then Exit Sub 'если ячейка В2 пустая, то выход
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row 'последняя заполненная строка в столбце 1
        Set Rng = .Range("A7:A" & LastRow).Find(CustomerName, , xlFormulas, xlWhole) 'производим поиск в стобце А (от А7 и ниже)
        If Rng Is Nothing Then 'если клиента НЕ нашли, то сообщение и выход
            MsgBox "Клиента с именем: '" & CustomerName & "' в таблице нет!", vbExclamation, "Внимание"
            Exit Sub
        End If
    End With
Изменено: New - 25.11.2021 18:54:36
Как заставить макрос дождаться завершения работы других макросов., запросы PQ
 
может эта тема поможет https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=104501
Как заставить макрос дождаться завершения работы других макросов., запросы PQ
 
какой способ из этих вы использовали? https://analystcave.com/excel-multithreading-vba-vs-vbscript-vs-c-net/
Как заставить макрос дождаться завершения работы других макросов., запросы PQ
 
вы реализовали многопоточность в VBA ?
На всех листах преобразовать текстовые записи чисел в числа
 
а макрос даже такой срабатывает (без каких-либо аргументов)
Код
Sub Макрос()
    Columns(1).TextToColumns
End Sub
[ Закрыто] Прописание условия в макросе
 
см. картинку
Изменено: New - 24.11.2021 22:13:57
Внести данные из формы в умную таблицу
 
Спасибо.
У Cells 2 аргумента, 1-й номер строки, 2-й номер столбца - Cells (номер строки, номер столбца).
Объект NewRow - это добавленная новая строка, у неё кол-во строк всего 1, т.е. 1 у Cells - это и есть добавленная строка.

Можно ещё так заносить данные
Код
Sub test()
    Dim tbl As ListObject
    Set tbl = ActiveSheet.ListObjects("Table1")
    'Column1 - название столбца в таблице
    tbl.ListColumns("Column1").DataBodyRange.Rows(2).Value = 5 '2 - это вторая ячейка ниже шапки
End Sub
Изменено: New - 24.11.2021 22:24:58
Почему результат вычислений не равен нулю?
 
Поставьте числовой формат и 2 десятичных знака в Сводной таблице по столбцу Сумма
P.S. Да, Excel может так считать... см. https://www.excel-vba.ru/chto-umeet-excel/excel-nepravilno-schitaet-pochemu/
Изменено: New - 24.11.2021 22:58:35
Отключение всех таймеров, Сбросить все ранее запущенные таймеры
 
вот вам бы всё усложнять)) перегрузят комп и всё нормализуется )
P.S. сейчас наговорите и все побегут писать вирусы с помощью неубиваемого Application.OnTime )
Изменено: New - 24.11.2021 21:55:02
Удаление значений в строках и удаление пустой ячейки со сдвигом влево.
 
так у вас в ячейке E18 написано "h". Это случайно или какой-то другой метод "выкидывания" ?
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 104 След.
Наверх