Сортировка файлов по размеру

Дата: Пятница, 20.03.2015, 16:30 | Сообщение № 1

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

Возможно ли с помощью ВБА отсортировать в папке (допустим C:\Фотки) файлы (рисунки с различными названиями и расширениями).
Есть папка, в ней порядка 60 000 разных картинок. Можно ли с помощью ВБА создать в этой папке (C:\Фотки) несколько папок, в которые раскидать файлы так, чтобы вес каждой папки не превышал, допустим 2мб? Названия создаваемых папок можно было бы задать произвольно (1, 2, 3 и тд. или что-то типа того)?

Много чего не знаю!!!!

Дата: Пятница, 20.03.2015, 16:36 | Сообщение № 2

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

Возможно, я дал некорректное наименование теме, это ведь больше "группировка" чем сортировка...)

Много чего не знаю!!!!

RAN

Дата: Пятница, 20.03.2015, 18:47 | Сообщение № 3

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

Объект FileSystemObject >> Объект File >> Свойство "Size"
И циклом его, циклом!
Да еще рекурсией!

PS
Если не считать мелочи типа

Цитата Roman777, 20.03.2015 в 16:30, в сообщении № 1

Названия создаваемых папок можно было бы задать произвольно

Задача разбивается на 2 основных вопроса
1. Получить список всех файлов и их размера.
2. Задача о рюкзаке.

Быть или не быть, вот в чем загвоздка!

Сообщение отредактировал RAN - Пятница, 20.03.2015, 19:11

Дата: Пятница, 20.03.2015, 19:09 | Сообщение № 4

Группа: Авторы

Ранг: Старожил

Сообщений: 1613

Репутация: 563 ±

Замечаний: 0% ±

Excel 2013, 2016

без FSO
[vba]

Код

Sub ertert()
Dim Fold As String, f As String, tSubFoldr$
With Application.FileDialog(msoFileDialogFolderPicker)
     .Title = "Select the folder in which the files to be processed"
     .ButtonName = "Select": .AllowMultiSelect = False
     If .Show Then Fold = .SelectedItems(1) Else Exit Sub
End With

If Right(Fold, 1) <> "\" Then Fold = Fold & "\"
f = Dir(Fold, vbNormal)
Do While f <> ""
     tSubFoldr = CStr(Int(FileLen(Fold & f) / 1048576) + 1)
     'MsgBox tSubFoldr
     If PathExists(Fold & tSubFoldr) = False Then MkDir Fold & tSubFoldr
     Name Fold & f As Fold & tSubFoldr & "\" & f
     f = Dir()    ' следующий файл
Loop
End Sub

Function PathExists(pname) As Boolean
On Error Resume Next
PathExists = (GetAttr(pname) And vbDirectory) = vbDirectory
End Function

[/vba]

Яндекс.Деньги 4100159601573

Дата: Пятница, 20.03.2015, 20:14 | Сообщение № 5

Группа: Авторы

Ранг: Старожил

Сообщений: 1613

Репутация: 563 ±

Замечаний: 0% ±

Excel 2013, 2016

Цитата Roman777, 20.03.2015 в 16:30, в сообщении № 1

чтобы вес каждой папки не превышал, допустим 2мб

а вот это я как раз и не прочитал. И ответ получился совсем не в тему. Упс

но все равно симпатичный кодец

Яндекс.Деньги 4100159601573

Дата: Суббота, 21.03.2015, 11:59 | Сообщение № 6

Группа: Авторы

Ранг: Старожил

Сообщений: 1613

Репутация: 563 ±

Замечаний: 0% ±

Excel 2013, 2016

... да, тот код именно сортировал файлы по размеру (тема так и называется!)
А вот этот - группирует файлы в папки установленного размера
Функция для "рюкзака" взята у Shg
[offtop]пока тестировал, зачем-то сгруппировал себе все файлы с картинками :)[/offtop]

К сообщению приложен файл: ___Cut_List3.xlsm (42.2 Kb)

Яндекс.Деньги 4100159601573

Дата: Понедельник, 23.03.2015, 10:06 | Сообщение № 7

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

RAN, nilem, Спасибо большое за ваши ответы. Я ещё посижу, поразбираю Ваши слова и код nilem.
Сразу хочу спросить nilem, я что-то не нахожу, где в коде задаётся номинальный вес папки, ато он мне ошибку выдаёт, что файл превышает вес папки (не серчайте, я профан и Ваш код мне кажется невероятно сложным, пока что).

Много чего не знаю!!!!

Дата: Понедельник, 23.03.2015, 10:17 | Сообщение № 8

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

nilem, О! походу чутка разобрался:
Sub ertert()

[vba]

Код

Dim f As String, tSubFoldr$, i&
Dim avInp(), FSO As FileSystemObject, fl As File
Dim dStk As Double
dStk = 2 ' Mb
'dStk = Range("ptrStk").Value2 ' Mb
k = 0

[/vba]
Насколько я понял, ранее он брал значение, определяющее размер из таблички (таблица на листе Sheet1?) Поэтому я поставил значение 2 переменной. Не понял только, как он понимает что это мегобайты, а не байты, например. Ведь далее в коде осуществляется деление относительно байтов :
[vba]

Код

avInp(i, 1) = fl.Size / 1048576 ' Mb

[/vba]

Чего-то я не допонимаю))).

Много чего не знаю!!!!

Дата: Понедельник, 23.03.2015, 10:23 | Сообщение № 9

Группа: Авторы

Ранг: Старожил

Сообщений: 1613

Репутация: 563 ±

Замечаний: 0% ±

Excel 2013, 2016

Цитата Roman777, 23.03.2015 в 10:17, в сообщении № 8

Чего-то я не допонимаю))).

правильно говорить "недоперепонял"

fl.Size дает размер файла в байтах. Делим его на 1048576 - получаются Мб. А потом сравниваем р-р файла в Мб с заданным р-ром dStk = 2 ' Mb

Яндекс.Деньги 4100159601573

Дата: Понедельник, 23.03.2015, 10:31 | Сообщение № 10

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

nilem, Спасибо, за инфу. Код работает красиво и сразу отчётик видно...)

Много чего не знаю!!!!

Дата: Среда, 25.03.2015, 09:29 | Сообщение № 11

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

nilem, Добрый день, я всё же решил чуть-чуть разобраться с этим кодом. Не могу понять следующее:
[vba]

Код

        If .Files.Count = 0 Then MsgBox ".Files.Count Nicht", 48: Exit Sub
         ReDim avInp(1 To .Files.Count, 1 To 3)
         For Each fl In .Files
             i = i + 1
             avInp(i, 1) = fl.Size / 1048576   ' Mb
             'если р-р какого-либо файла превышает установленный р-р папки
             If avInp(i, 1) > dStk Then MsgBox "avInp(i, 1) > dStk Nicht", 48: Exit Sub
             avInp(i, 2) = 1
             avInp(i, 3) = fl.Path
         Next fl

[/vba]
Зачем мы переменную задаём как двухмерный массив
[vba]

Код

ReDim avInp(1 To .Files.Count, 1 To 3)

[/vba]
и зачем существует во втором "измерении" массива переменная 2, равная 1?:
[vba]

Код

avInp(i, 2) = 1

[/vba]

Много чего не знаю!!!!