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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 98 След.
Макрос сумы ячеек по разным файлам в папке
 
как вариант

Код
Sub main()
    Dim ipath$, fname$, isum&, addr$
    Application.ScreenUpdating = False
    ipath = "Путь к файлам"
    addr = ActiveCell.Address
    fname = Dir(ipath)
    Do While fname <> ""
        If fname <> ThisWorkbook.Name Then
            With GetObject(ipath & fname).Worksheets(1)
                isum = isum + .Range(addr).Value
                .Parent.Close False
            End With
        End If
        fname = Dir
    Loop
    Application.ScreenUpdating = True
    msgbox isum
End Sub
"Все гениальное просто, а все простое гениально!!!"
Макрос сумы ячеек по разным файлам в папке
 
Цитата
dima_dso написал:
2. Чтоб каждый раз не выбирать папку, а прописать в макросе адрес папки.
Вот тут то в чем проблема? это же проще чем написать блок
Код
With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Укажите рабочую папку"
        .Show
        If .SelectedItems.Count = 0 Then Exit Sub
        myPath = .SelectedItems(1) & Application.PathSeparator
    End With

просто переменной присваиваете полный путь к папке
Код
 myPath = "Путь к файлам"
"Все гениальное просто, а все простое гениально!!!"
Удаление одинаковых пар в двух столбцах
 
Ну а если нужна сумма то пожалуйста
Код
Sub main()
    Dim arr(), dic As Object, txt$
    Dim lrow&, i&, ikey
     
    Set dic = CreateObject("scripting.dictionary")
    lrow = Range("a" & Rows.Count).End(xlUp).Row
    arr = Range("a2:c" & lrow).Value
    For i = 1 To UBound(arr)
        If arr(i, 1) > arr(i, 2) Then
            txt = arr(i, 1) & "|" & arr(i, 2)
        Else: txt = arr(i, 2) & "|" & arr(i, 1)
        End If
        dic.Item(txt) = dic.Item(txt) + arr(i, 3)
    Next i
    Erase arr: i = 0
    ReDim arr(dic.Count, 3)
    For Each ikey In dic.keys
        arr(i, 0) = Split(ikey, "|", 2)(0)
        arr(i, 1) = Split(ikey, "|", 2)(1)
        arr(i, 2) = dic.Item(ikey)
        i = i + 1
    Next ikey
    [a1].Resize(, 3).Copy [e1]
    [e2].Resize(dic.Count, 3).Value = arr
End Sub
"Все гениальное просто, а все простое гениально!!!"
Удаление одинаковых пар в двух столбцах
 
Kuzmich,
А где написано что нужно суммировать?, как нужно я в файле не увидел, увидел только помеченные пересечения
"Все гениальное просто, а все простое гениально!!!"
Удаление одинаковых пар в двух столбцах
 
Kuzmich,
А почему бы и нет?
"Все гениальное просто, а все простое гениально!!!"
Удаление одинаковых пар в двух столбцах
 
aleksa_yara, Вы уверены что код из #17 сообщения отрабатывает 1-2 часа, сделал 180 тыс. строк, на своем старом ПК 4 гб. оперативки Core2Quad Q6600
Отработал за 10-15 сек.
"Все гениальное просто, а все простое гениально!!!"
Удаление одинаковых пар в двух столбцах
 
Еще вариант
Код
Sub main()
    Dim arr(), dic As Object, txt$
    Dim lrow&, i&, ikey
    
    Set dic = CreateObject("scripting.dictionary")
    lrow = Range("a" & Rows.Count).End(xlUp).Row
    arr = Range("a2:c" & lrow).Value
    For i = 1 To UBound(arr)
        If arr(i, 1) > arr(i, 2) Then
            txt = arr(i, 1) & "|" & arr(i, 2)
        Else: txt = arr(i, 2) & "|" & arr(i, 1)
        End If
        dic.Item(txt) = arr(i, 3)
    Next i
    Erase arr: i = 0
    ReDim arr(dic.Count, 3)
    For Each ikey In dic.keys
        arr(i, 0) = Split(ikey, "|", 2)(0)
        arr(i, 1) = Split(ikey, "|", 2)(1)
        arr(i, 2) = dic.Item(ikey)
        i = i + 1
    Next ikey
    [a1].Resize(, 3).Copy [e1]
    [e2].Resize(dic.Count, 3).Value = arr
End Sub
"Все гениальное просто, а все простое гениально!!!"
Универсальный макрос ВПР (выгрузка в диапазон найденных значений)
 
Цитата
Drulas написал:
не могу отредактировать под свои нужды
Создайте тему опишите задачу, может можно сделать проще. Пароль к сожалению не помню, да и для чего ставил его так же не  припоминаю.
"Все гениальное просто, а все простое гениально!!!"
Подсчет указанных элементов массива без использования цикла
 
Цитата
OlegO написал:
В реальном коде данные в этот массив попадут из словаря
Если есть словарь, для чего массив? а так же если из ключей словаря, то тут можно сразу сказать что они уникальные и больше единицы вы в итоге не получите при пересчете
"Все гениальное просто, а все простое гениально!!!"
Подсчет указанных элементов массива без использования цикла
 
Код
Sub main()
    Dim Arr_Count(4)
    Dim arr$()
    Arr_Count(0) = "a"
    Arr_Count(1) = "c"
    Arr_Count(2) = "c"
    Arr_Count(3) = "c"
    Arr_Count(4) = "d"
    arr = Filter(Arr_Count, "c")
    MsgBox UBound(arr) + 1
End Sub


Но фильтруемый массив должен быть одномерным.
Изменено: Nordheim - 23 Мар 2020 09:27:49
"Все гениальное просто, а все простое гениально!!!"
Найти артикул в другой книге и заполнить ячейки
 
Цитата
aybek04 написал:
открываю Файл А сортируя ищу Артикул вожу на против значение с Файла Б.
какое значение?
Цитата
aybek04 написал:
потом открываю Файл Б и ввожу и туда уже полученные значения
тот же вопрос, какое значение?
"Все гениальное просто, а все простое гениально!!!"
Выпадающий списко в userForm с уникальными значениями
 
можно так сделать, но не уверен, что не убрал, что то важное из функционала
"Все гениальное просто, а все простое гениально!!!"
Путь к файлу при консолидации таблиц
 
Цитата
Настя_Nastya написал:
судя из описания задачи, файлы
Цитата
Salva написал:
при нахождении файла на рабочем столе
Тут не сказано что файлы, поэтому и уточнил.
"Все гениальное просто, а все простое гениально!!!"
Путь к файлу при консолидации таблиц
 
По хорошему, что бы у всех работал код от Насти, нужно что бы обе книги (откуда берутся данные, куда вносятся данные) находились в одной дирректории.
"Все гениальное просто, а все простое гениально!!!"
VBA Управление записями в БД через интерфейс в Excel(ADODB + MS SQL Server)
 
Вы уверены, что в правильной теме задали вопрос?
"Все гениальное просто, а все простое гениально!!!"
Перебор строк двумерного массива, способы получить все строки массива
 
Глянуть бы, полностью что есть и что на выходе, а то прям танцы с бубнами получаются какие-то :)
"Все гениальное просто, а все простое гениально!!!"
Перебор строк двумерного массива, способы получить все строки массива
 
Цитата
RAN написал:
Где в словарях цикл
Перебор элементов, можно назвать циклом  :D
"Все гениальное просто, а все простое гениально!!!"
Перебор строк двумерного массива, способы получить все строки массива
 
Цитата
Мартын написал:
И как засунуть в OnePl всю строку сразу, а не поэлементно.
Сделать в цикле второй цикл, по строкам массива запоняя одномерный массив, и запихивая его в словарь что то типа
Код
Sub main()
Dim arr(), coll As Object
Dim i&, j&, ikey
arr = tabl
ReDim iarr(UBound(arr, 2))
Set coll = CreateObject("scripting.dictionary")
For i = 0 To UBound(arr)
   arr(i, 1) = i
   For j = 0 To UBound(arr, 2)
      iarr(j) = arr(i, j)
   Next j
   coll.Item(CStr(i)) = iarr
Next i

For Each ikey In coll
    Debug.Print Join(coll.Item(ikey), " | ")
Next ikey
End Sub

Function tabl()
    Dim i&, j&, arr(9, 9)
    For i = 1 To 10
        For j = 1 To 10
            arr(i - 1, j - 1) = i * j
    Next j, i
    tabl = arr
End Function

Но нужно ли это?
"Все гениальное просто, а все простое гениально!!!"
Перебор строк двумерного массива, способы получить все строки массива
 
Цитата
Мартын написал:
Почему в строке OnePl = PlArr(i) вылетает Subscript out of range?
Посмотрите мерность массива, с листа всегда берется двухмерный, а вы обращаетесь при присвоении к одномерному, в итоге и получаете ошибку
"Все гениальное просто, а все простое гениально!!!"
Перебор строк двумерного массива, способы получить все строки массива
 
Цитата
Мартын написал:
Недавно наткнулся, что для словаря For each на пару порядков быстрее чем For i.
Для словаря и коллекции да, на обычном массиве я не увидел разницы.
"Все гениальное просто, а все простое гениально!!!"
Перебор строк двумерного массива, способы получить все строки массива
 
А для чего нужен такой беребор, даже если таковой найдется , все равно обращаться скорее всего будете к элементу массива по индексу.Можно заполнять коллекцию строчными массивами, а потом по коллекции делать цикл, как вариант.
Изменено: Nordheim - 16 Мар 2020 09:53:02
"Все гениальное просто, а все простое гениально!!!"
Ошибка при переключении вкладок MultiPage в UserForm, Ошибка: "вызванный объект был отключен от клиентов"
 
Цитата
RAN написал:
После примерно 30-40 секундного хаотического клацания по самым разным местам формы
Вчера попробовал, аналогично раз 40 клацнул, только после этого выдало окно с ошибкой на доли секунды и Excel закрылся. Если сотрудник таким образом работает, то ему нужны счеты а не ПК.  :)
"Все гениальное просто, а все простое гениально!!!"
Ошибка при переключении вкладок MultiPage в UserForm, Ошибка: "вызванный объект был отключен от клиентов"
 
Можно сделать так
Изменено: Nordheim - 13 Мар 2020 08:57:21
"Все гениальное просто, а все простое гениально!!!"
Отправка файлов по электронной почте находящихся в одном файле
 
А что именно не понятно, по ссылке из сообщения создайте массив полных имен файлов, которые хотите отправить, а затем вашим кодом в цикле по массиву отправляйте файлы.
"Все гениальное просто, а все простое гениально!!!"
Транспонирование массива строк в столбцы и последующее удаление строк (VBA)
 
Код
Sub main()
    Dim lrow&, i&, ikey, sarr$(), j&
    Dim arr(), txt$, objDic As Object
    Set objDic = CreateObject("scripting.dictionary")
    lrow = Range("b" & Rows.Count).End(xlUp).Row
    arr = Range("a1:b" & lrow).Value
    For i = 2 To UBound(arr)
        If Not IsEmpty(arr(i, 1)) Then
            j = j + 1
            txt = j & "|" & arr(i, 1)
        End If
        objDic.Item(txt) = objDic.Item(txt) & arr(i, 2) & "|"
    Next i
    i = 1
    For Each ikey In objDic.keys
        i = i + 1
        sarr = Split(objDic(ikey), "|")
        Range("c" & i).Value = Split(ikey, "|")(1)
        Range("d" & i).Resize(, UBound(sarr)).Value = sarr
    Next ikey
    Cells.WrapText = False
End Sub
"Все гениальное просто, а все простое гениально!!!"
Транспонирование массива строк в столбцы и последующее удаление строк (VBA)
 
Цитата
Alex_M2020 написал:
Прошу помочь написать макрос
А что не получается, в чем требуется помощь, где попытки, что то сделать? Я вижу файл, в котором арпиори макросов не может быть. А если так, то и нужно писать, что нужно не помочь написать, а все сделать за вас с нуля.
"Все гениальное просто, а все простое гениально!!!"
[ Закрыто] Групповое переименовывание файлов в нужной папке
 
Цитата
haziness написал:
как-то путь до выбранной папки можно в одну из ячеек вывести?
А зачем? Я специально не стал использовать ячейку для пути, а реализовал глобальныю переменную. Думаю, что вывести путь в ячейку вы сможете без особых затруднений. Тем более там нужно добавить одну строку в код.
типа
Код
cells(i,j).value = generalpath
где i и j координаты ячейки на листе.
Изменено: Nordheim - 25 Фев 2020 08:02:21
"Все гениальное просто, а все простое гениально!!!"
[ Закрыто] Групповое переименовывание файлов в нужной папке
 
Цитата
haziness написал:
сразу переименовывание той папки, которую в первый раз выбирали
"Все гениальное просто, а все простое гениально!!!"
[ Закрыто] Групповое переименовывание файлов в нужной папке
 
может так?
"Все гениальное просто, а все простое гениально!!!"
Макрос/функция автозамены значений при совпадении в словаре
 
Цитата
Alez написал:
Nordheim , если честно, так и не понял, как он работает
Там же закладка добавлена, на ней кнопка, жмете и вуаля.
"Все гениальное просто, а все простое гениально!!!"
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 98 След.
Наверх