По этому поводу припомнилась не сильно давняя история: друг-скриптописатель (не на VB) со мной связывается и спрашивает так ненароком "как это может быть - Cells(0,0) ? Меня ведь учили, что ячейки всегда нумеруются от 1..." Я ему начинаю втирать, что такого кода быть не может в принципе, что это - чистый рантайм-эррор и т.д. Дело доходит до того, что он все же вырывает и приносит в клювике кусочек кода, где это написано. Смотрю я на этот код, и начинает меня мучить мысль, что всё это я уже видел и внезапно понимаю, что это мой код который был как-то писан... Недоразумения разъяснились, но пришлось человека сразу направить к истокам - поизучать основы по иерархии объектов... Код, понятное дело, был из разряда: [vba]
Код
With oTable ' куча-куча строчек .Cells(0, 0).Resize(...
[/vba]Ну не смущала его точка
[offtop]Чегой-то тема совсем стала офф...
Кстати, насчет точек Знающих людей никак не смутит конструкция вида: : ?. ( x -- ) . ;[/offtop]
По этому поводу припомнилась не сильно давняя история: друг-скриптописатель (не на VB) со мной связывается и спрашивает так ненароком "как это может быть - Cells(0,0) ? Меня ведь учили, что ячейки всегда нумеруются от 1..." Я ему начинаю втирать, что такого кода быть не может в принципе, что это - чистый рантайм-эррор и т.д. Дело доходит до того, что он все же вырывает и приносит в клювике кусочек кода, где это написано. Смотрю я на этот код, и начинает меня мучить мысль, что всё это я уже видел и внезапно понимаю, что это мой код который был как-то писан... Недоразумения разъяснились, но пришлось человека сразу направить к истокам - поизучать основы по иерархии объектов... Код, понятное дело, был из разряда: [vba]
Код
With oTable ' куча-куча строчек .Cells(0, 0).Resize(...
[/vba]Ну не смущала его точка
[offtop]Чегой-то тема совсем стала офф...
Кстати, насчет точек Знающих людей никак не смутит конструкция вида: : ?. ( x -- ) . ;[/offtop]AndreTM
а давайте вместе ждать? людей много. но вот дураков, которые, видя наглядный пример, как Вы реагируете на правильный код и подробные разъяснения, возьмутся за столь неблагодарное дело...нету. но вдруг появятся, ага?
Банально - Флуд, это во - первых. Во-вторых, Ваше мнение - это мнение фрилансера, а не человека, которых Вы считаете "дураками". Это профессионалу может быть всё очевидно, а новичку - далеко не так. Я затем сюда и пришёл, за помощью. Выучить VBA за месяц - дело не из простых. Вынужден задавать вопросы.
Что предосудительного в том, что мне что-то не понятно?. Да и потом, настоящий профессионал, не кичится своими познаниями, позволяя себе насмешку, упрёки, язвительные замечания, а снисходительно либо разъяснит, либо укажет на источник. Ну а на "нет" и суда "нет".
а давайте вместе ждать? людей много. но вот дураков, которые, видя наглядный пример, как Вы реагируете на правильный код и подробные разъяснения, возьмутся за столь неблагодарное дело...нету. но вдруг появятся, ага?
Банально - Флуд, это во - первых. Во-вторых, Ваше мнение - это мнение фрилансера, а не человека, которых Вы считаете "дураками". Это профессионалу может быть всё очевидно, а новичку - далеко не так. Я затем сюда и пришёл, за помощью. Выучить VBA за месяц - дело не из простых. Вынужден задавать вопросы.
Что предосудительного в том, что мне что-то не понятно?. Да и потом, настоящий профессионал, не кичится своими познаниями, позволяя себе насмешку, упрёки, язвительные замечания, а снисходительно либо разъяснит, либо укажет на источник. Ну а на "нет" и суда "нет".Vostok
"Посылая кого-то в Google, Помните, завтра туда могут Послать Вас !"
есть необходимость перед выгрузкой на лист отсортировать этот массив от поздней даты к ранней
Просьба, на мой взгляд, высказана максимально конкретно - Сортировать массив до выгрузки на Лист. Далее получаем "дар" от AndreTM:
[vba]
Код
....................................................................................................... With sh.Cells(1, 1).Resize(UBound(CSVarr, 1), UBound(CSVarr, 2)) .Value = CSVarr .Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlGuess CSVarr = .Value .Sort End With ........................................................................................................
[/vba]
Нетрудно догадаться, что Массив заливается на Лист, там сортируется и потом опять Заливается в Массив (совсем не так как хотелось). А чтобы ничего не было видно Лист удаляется, но почему-то в сопровождении отключения и включения Алертов:
Только при чём тут Алерты? Тогда уж обновление экрана бы выключили, чтобы я вообще ничего не заметил. Новичок же. А значит дурачок. И в Locals то ничего не увидишь, там даты принимают формат числа. И не стал бы я это всё анализировать, если бы в последствии не прилетело в мой адрес гора обвинений и упрёков:
Оффтоп: Вывод - вы вообще не читаете не то что код, а даже и сам смысл ответов до вас не доходит. Вам подавай "готовенькое и под вас". Вам подают (от широты душевной). Но вы, походу, не понимаете даже этого...
Всё это похоже на то, когда приходишь к кому то за помощью, а он идёт в сарай, вываливает пару мешков тебе, что под руку попалось, и говорит : "Ну сам тут поковыряйся, может что и найдёшь". Да я и не возражаю, может это и "правильно", но если бы это не сопровождалось язвительными комментариями и Маской "Великодушия".
Ну а теперь собственно о главном, о сортировки внутри массива. Зачем мне это понадобилось то? А чтобы это понять нужно просто взять 1000 файлов .csv и обработать их двумя методами: с сортировкой в Массиве и с Сортировкой на Листе, и таймер в процедуру поставить. Вот тогда всё станет понятно, из-за чего задача и ставилась. Массив - это оперативная память и операция по времени сокращается в треть. Кому захочется поспорить, проделайте сами, или загляните к Д. Уокенбаху "Проф. программирование на VBA".
Ну что ж решение всё-таки найдено, но сперва оценим "великодушие" господина AndreTM. Итак, что нам было предложено.
есть необходимость перед выгрузкой на лист отсортировать этот массив от поздней даты к ранней
Просьба, на мой взгляд, высказана максимально конкретно - Сортировать массив до выгрузки на Лист. Далее получаем "дар" от AndreTM:
[vba]
Код
....................................................................................................... With sh.Cells(1, 1).Resize(UBound(CSVarr, 1), UBound(CSVarr, 2)) .Value = CSVarr .Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlGuess CSVarr = .Value .Sort End With ........................................................................................................
[/vba]
Нетрудно догадаться, что Массив заливается на Лист, там сортируется и потом опять Заливается в Массив (совсем не так как хотелось). А чтобы ничего не было видно Лист удаляется, но почему-то в сопровождении отключения и включения Алертов:
Только при чём тут Алерты? Тогда уж обновление экрана бы выключили, чтобы я вообще ничего не заметил. Новичок же. А значит дурачок. И в Locals то ничего не увидишь, там даты принимают формат числа. И не стал бы я это всё анализировать, если бы в последствии не прилетело в мой адрес гора обвинений и упрёков:
Оффтоп: Вывод - вы вообще не читаете не то что код, а даже и сам смысл ответов до вас не доходит. Вам подавай "готовенькое и под вас". Вам подают (от широты душевной). Но вы, походу, не понимаете даже этого...
Всё это похоже на то, когда приходишь к кому то за помощью, а он идёт в сарай, вываливает пару мешков тебе, что под руку попалось, и говорит : "Ну сам тут поковыряйся, может что и найдёшь". Да я и не возражаю, может это и "правильно", но если бы это не сопровождалось язвительными комментариями и Маской "Великодушия".
Ну а теперь собственно о главном, о сортировки внутри массива. Зачем мне это понадобилось то? А чтобы это понять нужно просто взять 1000 файлов .csv и обработать их двумя методами: с сортировкой в Массиве и с Сортировкой на Листе, и таймер в процедуру поставить. Вот тогда всё станет понятно, из-за чего задача и ставилась. Массив - это оперативная память и операция по времени сокращается в треть. Кому захочется поспорить, проделайте сами, или загляните к Д. Уокенбаху "Проф. программирование на VBA".Vostok
"Посылая кого-то в Google, Помните, завтра туда могут Послать Вас !"
Сообщение отредактировал Vostok - Воскресенье, 12.10.2014, 09:55
Процедура Загрузки .csv в Массив с последующей его сортировкой:
[vba]
Код
Sub Загрузка_Данных_Из_CSV_в_Массив()
Dim filename As String Dim CSVarr() As Variant Dim i As Long
filename = "d:\totalpc.csv"
CSVarr = LoadArrayFromTextFile(filename) 'Отправляем файл на обработку в функцию разбивки по столбцам CSVarr = ShellSort22(CSVarr, 1) 'Передаём Массив на сортировку по методу Шелла по первому столбцу
'Выгружаем Массив на лист Dim TheRange As Range Set TheRange = Range("A1").Cells(1, 1).Resize(UBound(CSVarr, 1), UBound(CSVarr, 2)) TheRange.Columns(1).NumberFormat = "dd.mm.yyyy"
TheRange = CSVarr
' проверка результата загрузки данных (выход из макроса, если данные не загружены) If Not IsArray(CSVarr) Then MsgBox "Файл CSV не обработан", vbCritical, "Ошибка": Exit Sub
End Sub
[/vba]
Функция Обработки .csv файла с разбивкой по столбцам (LoadArrayFromTextFile):
[vba]
Код
Function LoadArrayFromTextFile(ByVal filename As String, _ Optional ByVal FirstRow As Long = 3, _ Optional ByVal ColumnsSeparator As String = ",", _ Optional ByVal RowsSeparator As String = vbNewLine) As Variant
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Функция открывает текстовый (CSV) файл filename, затем ' Загружает его в массив данных, начиная со строки FirstRow, ' В качестве параметров можно задать разделители строк и столбцов ' (т.е. ТЕ разделители, какие стоят в исходном файле CSV) ' Функция возвращает двумерный массив - результат преобразования текстового файла в двумерный массив ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim FSO As Object Dim ts As Object Dim txt As String Dim RowsCount As Variant, ColumnsCount As Variant Dim i As Long, j As Long Dim tmpArr1 As Variant Dim tmpArr2 As Variant
On Error Resume Next Set FSO = CreateObject("scripting.filesystemobject") '--- читаем текст из выбранного файла Set ts = FSO.OpenTextFile(filename, 1, True): txt = ts.ReadAll: ts.Close Set ts = Nothing: Set FSO = Nothing
txt = Trim(txt): Err.Clear '------------------------- разделяем текст на строки и столбцы If txt Like "*" & RowsSeparator Then txt = Left(txt, Len(txt) - Len(RowsSeparator))
If FirstRow > 1 Then '---------------------------------------- обрезаем ненужные строки txt = Split(txt, RowsSeparator, FirstRow)(FirstRow - 1) End If
If Err.Number > 0 Then MsgBox "Текст файла " & Dir(filename, vbNormal) & _ " не может быть считан в двумерный массив", vbCritical: Exit Function ReDim arr(1 To RowsCount, 1 To ColumnsCount)
For i = LBound(tmpArr1) To UBound(tmpArr1) tmpArr2 = Split(Trim(tmpArr1(i)), ColumnsSeparator) For j = 1 To UBound(tmpArr2) + 1 arr(i + 1, j) = tmpArr2(j - 1) Next j
arr(i + 1, 1) = CDate(Mid(arr(i + 1, 1) & "/" & arr(i + 1, 1), 7, 10)) Next i
LoadArrayFromTextFile = arr ' возвращаем результат в виде двумерного массива
End Function
[/vba]
ИТАК, ГОТОВОЕ ИТОГОВОЕ РЕШЕНИЕ в "ОДНОМ" ФЛАКОНЕ.
Процедура Загрузки .csv в Массив с последующей его сортировкой:
[vba]
Код
Sub Загрузка_Данных_Из_CSV_в_Массив()
Dim filename As String Dim CSVarr() As Variant Dim i As Long
filename = "d:\totalpc.csv"
CSVarr = LoadArrayFromTextFile(filename) 'Отправляем файл на обработку в функцию разбивки по столбцам CSVarr = ShellSort22(CSVarr, 1) 'Передаём Массив на сортировку по методу Шелла по первому столбцу
'Выгружаем Массив на лист Dim TheRange As Range Set TheRange = Range("A1").Cells(1, 1).Resize(UBound(CSVarr, 1), UBound(CSVarr, 2)) TheRange.Columns(1).NumberFormat = "dd.mm.yyyy"
TheRange = CSVarr
' проверка результата загрузки данных (выход из макроса, если данные не загружены) If Not IsArray(CSVarr) Then MsgBox "Файл CSV не обработан", vbCritical, "Ошибка": Exit Sub
End Sub
[/vba]
Функция Обработки .csv файла с разбивкой по столбцам (LoadArrayFromTextFile):
[vba]
Код
Function LoadArrayFromTextFile(ByVal filename As String, _ Optional ByVal FirstRow As Long = 3, _ Optional ByVal ColumnsSeparator As String = ",", _ Optional ByVal RowsSeparator As String = vbNewLine) As Variant
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Функция открывает текстовый (CSV) файл filename, затем ' Загружает его в массив данных, начиная со строки FirstRow, ' В качестве параметров можно задать разделители строк и столбцов ' (т.е. ТЕ разделители, какие стоят в исходном файле CSV) ' Функция возвращает двумерный массив - результат преобразования текстового файла в двумерный массив ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim FSO As Object Dim ts As Object Dim txt As String Dim RowsCount As Variant, ColumnsCount As Variant Dim i As Long, j As Long Dim tmpArr1 As Variant Dim tmpArr2 As Variant
On Error Resume Next Set FSO = CreateObject("scripting.filesystemobject") '--- читаем текст из выбранного файла Set ts = FSO.OpenTextFile(filename, 1, True): txt = ts.ReadAll: ts.Close Set ts = Nothing: Set FSO = Nothing
txt = Trim(txt): Err.Clear '------------------------- разделяем текст на строки и столбцы If txt Like "*" & RowsSeparator Then txt = Left(txt, Len(txt) - Len(RowsSeparator))
If FirstRow > 1 Then '---------------------------------------- обрезаем ненужные строки txt = Split(txt, RowsSeparator, FirstRow)(FirstRow - 1) End If
If Err.Number > 0 Then MsgBox "Текст файла " & Dir(filename, vbNormal) & _ " не может быть считан в двумерный массив", vbCritical: Exit Function ReDim arr(1 To RowsCount, 1 To ColumnsCount)
For i = LBound(tmpArr1) To UBound(tmpArr1) tmpArr2 = Split(Trim(tmpArr1(i)), ColumnsSeparator) For j = 1 To UBound(tmpArr2) + 1 arr(i + 1, j) = tmpArr2(j - 1) Next j
arr(i + 1, 1) = CDate(Mid(arr(i + 1, 1) & "/" & arr(i + 1, 1), 7, 10)) Next i
LoadArrayFromTextFile = arr ' возвращаем результат в виде двумерного массива
И наконец, Сортировка Массива методом Шелла (ShellSort22), любезно предоставленная nilem с небольшой корректировкой:
[vba]
Код
Function ShellSort22(x, k As Long) 'Сортировка Шелла. Сортируем 2-мерный массив x по столбцу k Dim Limit As Long, Switch As Long, i&, j&, u& Dim ubx&, t ubx = UBound(x, 2): j = (UBound(x) - LBound(x) + 1) \ 2 Do While j > 0 Limit = UBound(x) - j Do Switch = LBound(x) - 1 For i = LBound(x) + 1 To Limit 'i = LBound(x) + 1 - сортируем со второй строки, чтобы оставить заголовок 'или прямо с первой строки i = LBound(x) ' If x(i, k) > x(i + j, k) Then 'по возрастанию If x(i, k) < x(i + j, k) Then 'по убыванию For u = 1 To ubx t = x(i, u) x(i, u) = x(i + j, u) x(i + j, u) = t Next Switch = i End If Next Limit = Switch - j Loop While Switch >= LBound(x) j = j \ 2 Loop: ShellSort22 = x
End Function
[/vba]
И наконец, Сортировка Массива методом Шелла (ShellSort22), любезно предоставленная nilem с небольшой корректировкой:
[vba]
Код
Function ShellSort22(x, k As Long) 'Сортировка Шелла. Сортируем 2-мерный массив x по столбцу k Dim Limit As Long, Switch As Long, i&, j&, u& Dim ubx&, t ubx = UBound(x, 2): j = (UBound(x) - LBound(x) + 1) \ 2 Do While j > 0 Limit = UBound(x) - j Do Switch = LBound(x) - 1 For i = LBound(x) + 1 To Limit 'i = LBound(x) + 1 - сортируем со второй строки, чтобы оставить заголовок 'или прямо с первой строки i = LBound(x) ' If x(i, k) > x(i + j, k) Then 'по возрастанию If x(i, k) < x(i + j, k) Then 'по убыванию For u = 1 To ubx t = x(i, u) x(i, u) = x(i + j, u) x(i + j, u) = t Next Switch = i End If Next Limit = Switch - j Loop While Switch >= LBound(x) j = j \ 2 Loop: ShellSort22 = x
Единственное, что можно будет добавить, это в Функции обработки .csv файла предусмотреть "обрезку" длины данных. Например в файле 3000 строк, а нам нужно взять только 1000. Но это уже другая тема.
Единственное, что можно будет добавить, это в Функции обработки .csv файла предусмотреть "обрезку" длины данных. Например в файле 3000 строк, а нам нужно взять только 1000. Но это уже другая тема.Vostok
"Посылая кого-то в Google, Помните, завтра туда могут Послать Вас !"
Vostok, вот здесь еще есть сортировки (просто Шелл мне больше нравится :)) [offtop]Да, формат даты я проглядел А решение получилось симпатичное.[/offtop]
Vostok, вот здесь еще есть сортировки (просто Шелл мне больше нравится :)) [offtop]Да, формат даты я проглядел А решение получилось симпатичное.[/offtop]nilem
Vostok, самое интересное, что вы так все же и не поняли, что вам предлагалось. Я предложил: - читаем данные в массив (той самой процедурой LoadArrayFromTextFile, без изменений), здесь же указываем начальную строку файла для чтения - проверяем корректность загрузки, если надо - делаем приведение типов, особое внимание уделяем датам (один проход по массиву); здесь же можно ограничить количество выгружаемых данных - выгружаем данные на лист - сортируем данные прямо на листе
Обратите внимание, что никакой повторной загрузки "с листа в массив" нет, это было сделано только для примера, чтобы вы увидели отсортированный массив как массив. В "рабочем" решении, если данные все равно должны оказаться на листе - никто не будет гонять их туда-сюда, естественно. Доп.лист для сортировки создается/удаляется с той же целью - как пример. Естественно, в рабочем скрипте данные выгрузились бы на существующий лист. А насчет алертов - вы пробовали сами удалять лист кодом VBA? Попробуйте без алертов, потом расскажете... И да, еще одно дополнение, которое я могу ещё предложить - это отключать автопересчет и отображение листа (Application.Calculation и Application.ScreenUpdating) на время сортировки. А то, что вы видите даты как числа - ещё раз повторюсь, это исключительно и только ваши настройки интерфейса... Я у себя в Locals при тестировании видел даты в массиве как "даты" Ну а то, что "даты" в Excel - это числа, написано в любом учебнике, надо бы знать...
И да, я не спорю, что сортировка по Шеллу вполне может выигрывать у встроенной (хотя там, вполне вероятно, тот же шелл ). Мне даже удивительно, что "время сократилось на треть" (точно на треть? не в три раза?) Ведь у меня "в методе" максимум времени отъедает именно перекачка данных (на лист ... с листа) + создание/удаление листа. Поскольку все остальные действия в наших с вами "алгоритмах" практически совпадают - замеры времени именно на сортировку надо проводить, только суммируя время работы соответствующего куска кода. У вас: [vba]
[/vba] Так что можете попробовать сравнить - у меня нет ваших 1000 файлов CSV. И уже с цифрами на руках рассказать, насколько выигрывает ваш метод.
Ладно, я согласен с тем, что вы просили "остсортировать массив ДО выгрузки на лист". Но для чего нужен именно такой порядок - нигде не указали. Более того, вы же сами выгружаете массив на лист сразу после сортировки. Именно поэтому я и предложил свой вариант, ведь в данном случае порядок действий (отсортировать->выгрузить или выгрузить->отсортировать) роли не играет. Если я что-то упускаю, и вы с отсортированным массивом в памяти производите ещё какие-то действия до выгрузки на лист - просветите нас.
Кстати, вы в мой кусок кода (первый спойлер в сообщении 24) зачем-то засунули двойную сортировку Я уж молчу про то, что у вас If Not IsArray(CSVarr) Then почему-то так и осталось в конце процедуры, когда вы уже вовсю поработали с, возможно, отсутствующим в природе массивом...
Vostok, самое интересное, что вы так все же и не поняли, что вам предлагалось. Я предложил: - читаем данные в массив (той самой процедурой LoadArrayFromTextFile, без изменений), здесь же указываем начальную строку файла для чтения - проверяем корректность загрузки, если надо - делаем приведение типов, особое внимание уделяем датам (один проход по массиву); здесь же можно ограничить количество выгружаемых данных - выгружаем данные на лист - сортируем данные прямо на листе
Обратите внимание, что никакой повторной загрузки "с листа в массив" нет, это было сделано только для примера, чтобы вы увидели отсортированный массив как массив. В "рабочем" решении, если данные все равно должны оказаться на листе - никто не будет гонять их туда-сюда, естественно. Доп.лист для сортировки создается/удаляется с той же целью - как пример. Естественно, в рабочем скрипте данные выгрузились бы на существующий лист. А насчет алертов - вы пробовали сами удалять лист кодом VBA? Попробуйте без алертов, потом расскажете... И да, еще одно дополнение, которое я могу ещё предложить - это отключать автопересчет и отображение листа (Application.Calculation и Application.ScreenUpdating) на время сортировки. А то, что вы видите даты как числа - ещё раз повторюсь, это исключительно и только ваши настройки интерфейса... Я у себя в Locals при тестировании видел даты в массиве как "даты" Ну а то, что "даты" в Excel - это числа, написано в любом учебнике, надо бы знать...
И да, я не спорю, что сортировка по Шеллу вполне может выигрывать у встроенной (хотя там, вполне вероятно, тот же шелл ). Мне даже удивительно, что "время сократилось на треть" (точно на треть? не в три раза?) Ведь у меня "в методе" максимум времени отъедает именно перекачка данных (на лист ... с листа) + создание/удаление листа. Поскольку все остальные действия в наших с вами "алгоритмах" практически совпадают - замеры времени именно на сортировку надо проводить, только суммируя время работы соответствующего куска кода. У вас: [vba]
[/vba] Так что можете попробовать сравнить - у меня нет ваших 1000 файлов CSV. И уже с цифрами на руках рассказать, насколько выигрывает ваш метод.
Ладно, я согласен с тем, что вы просили "остсортировать массив ДО выгрузки на лист". Но для чего нужен именно такой порядок - нигде не указали. Более того, вы же сами выгружаете массив на лист сразу после сортировки. Именно поэтому я и предложил свой вариант, ведь в данном случае порядок действий (отсортировать->выгрузить или выгрузить->отсортировать) роли не играет. Если я что-то упускаю, и вы с отсортированным массивом в памяти производите ещё какие-то действия до выгрузки на лист - просветите нас.
Кстати, вы в мой кусок кода (первый спойлер в сообщении 24) зачем-то засунули двойную сортировку Я уж молчу про то, что у вас If Not IsArray(CSVarr) Then почему-то так и осталось в конце процедуры, когда вы уже вовсю поработали с, возможно, отсутствующим в природе массивом...AndreTM
Skype: andre.tm.007 Donate: Qiwi: 9517375010
Сообщение отредактировал AndreTM - Воскресенье, 12.10.2014, 15:38
Сильно не вникал, но мно не понятно зачем для сортировки организовывать 4 вложенных цикла? Возможно для ускорения? На досуге посмотрю. А пока предлагаю ТС. Вместо вынесенных функций считывания и сортировк сделать всё одной процедурой. код модуля: [vba]
Код
Option Explicit
Sub QWERT() Dim A() As String, NAME, Delimiter, i, j, C, T() As String, M(), Max As Date, Nm, TEM Delimiter = "," NAME = ActiveWorkbook.Path & "\totalpc.csv" ' читаем в массив строки A = Split(CreateObject("Scripting.FileSystemObject").Getfile(NAME).OpenasTextStream(1).ReadAll, vbNewLine) C = UBound(Split(A(i), Delimiter)) ReDim M(UBound(A), C ) For i = 0 To UBound(A) - 1 ' по всем строкам T = Split(A(i), Delimiter) ' разбиваем по элементам For j = 0 To C M(i, j) = T(j) Next j Next i 'cортировка For i = 3 To UBound(A) - 1 Max = M(i, 0) Nm = i For j = i + 1 To UBound(A) If Max < M(j, 0) Then Max = M(j, 0) Nm = j End If Next j For j = 0 To C TEM = M(i, j) M(i, j) = M(Nm, j) M(Nm, j) = TEM Next j Next i Лист1.Cells.ClearContents Лист1.Range("A1").Resize(UBound(M), UBound(M, 2)+1) = M MsgBox "ok", 64, "" End Sub
[/vba] текстовик должен быть рядом с книгой.
Сильно не вникал, но мно не понятно зачем для сортировки организовывать 4 вложенных цикла? Возможно для ускорения? На досуге посмотрю. А пока предлагаю ТС. Вместо вынесенных функций считывания и сортировк сделать всё одной процедурой. код модуля: [vba]
Код
Option Explicit
Sub QWERT() Dim A() As String, NAME, Delimiter, i, j, C, T() As String, M(), Max As Date, Nm, TEM Delimiter = "," NAME = ActiveWorkbook.Path & "\totalpc.csv" ' читаем в массив строки A = Split(CreateObject("Scripting.FileSystemObject").Getfile(NAME).OpenasTextStream(1).ReadAll, vbNewLine) C = UBound(Split(A(i), Delimiter)) ReDim M(UBound(A), C ) For i = 0 To UBound(A) - 1 ' по всем строкам T = Split(A(i), Delimiter) ' разбиваем по элементам For j = 0 To C M(i, j) = T(j) Next j Next i 'cортировка For i = 3 To UBound(A) - 1 Max = M(i, 0) Nm = i For j = i + 1 To UBound(A) If Max < M(j, 0) Then Max = M(j, 0) Nm = j End If Next j For j = 0 To C TEM = M(i, j) M(i, j) = M(Nm, j) M(Nm, j) = TEM Next j Next i Лист1.Cells.ClearContents Лист1.Range("A1").Resize(UBound(M), UBound(M, 2)+1) = M MsgBox "ok", 64, "" End Sub
[/vba] текстовик должен быть рядом с книгой.alex77755
Могу помочь в VB6, VBA Alex77755@mail.ru
Сообщение отредактировал alex77755 - Понедельник, 13.10.2014, 09:08
Private Function aQSort2(ByRef a() As Variant, ByVal n As Integer, ByRef low As Long, ByRef high As Long) 'aQSort2 vData, 5, LBound(vData), UBound(vData) Dim i As Long, j As Long, k As Long Dim m As Variant, wsp As Variant i = low j = high m = a(Round((i + j) \ 2), n) Do Until i > j Do While a(i, n) < m i = i + 1 Loop Do While a(j, n) > m j = j - 1 Loop If (i <= j) Then For k = LBound(a, 2) To UBound(a, 2) wsp = a(i, k) a(i, k) = a(j, k) a(j, k) = wsp Next k i = i + 1 j = j - 1 End If Loop If (low < j) Then aQSort2 a(), n, low, j If (i < high) Then aQSort2 a(), n, i, high End Function
[/vba]
Я-А
[vba]
Код
Private Function aQSort2_Я_А(ByRef a() As Variant, ByVal n As Integer, ByRef low As Long, ByRef high As Long) 'aQSort2 vData, 5, LBound(vData), UBound(vData) Dim i As Long, j As Long, k As Long Dim m As Variant, wsp As Variant i = low j = high m = a(Round((i + j) \ 2), n) Do Until i > j Do While a(i, n) > m i = i + 1 Loop Do While a(j, n) < m j = j - 1 Loop If (i <= j) Then For k = LBound(a, 2) To UBound(a, 2) wsp = a(i, k) a(i, k) = a(j, k) a(j, k) = wsp Next k i = i + 1 j = j - 1 End If Loop If (low < j) Then aQSort2_Я_А a(), n, low, j If (i < high) Then aQSort2_Я_А a(), n, i, high End Function
[/vba]
Мне больше Всего нравятся - Самый быстрый из того, что я пробовал.
Вставлю и свои 5 копеек: А-Я
[vba]
Код
Private Function aQSort2(ByRef a() As Variant, ByVal n As Integer, ByRef low As Long, ByRef high As Long) 'aQSort2 vData, 5, LBound(vData), UBound(vData) Dim i As Long, j As Long, k As Long Dim m As Variant, wsp As Variant i = low j = high m = a(Round((i + j) \ 2), n) Do Until i > j Do While a(i, n) < m i = i + 1 Loop Do While a(j, n) > m j = j - 1 Loop If (i <= j) Then For k = LBound(a, 2) To UBound(a, 2) wsp = a(i, k) a(i, k) = a(j, k) a(j, k) = wsp Next k i = i + 1 j = j - 1 End If Loop If (low < j) Then aQSort2 a(), n, low, j If (i < high) Then aQSort2 a(), n, i, high End Function
[/vba]
Я-А
[vba]
Код
Private Function aQSort2_Я_А(ByRef a() As Variant, ByVal n As Integer, ByRef low As Long, ByRef high As Long) 'aQSort2 vData, 5, LBound(vData), UBound(vData) Dim i As Long, j As Long, k As Long Dim m As Variant, wsp As Variant i = low j = high m = a(Round((i + j) \ 2), n) Do Until i > j Do While a(i, n) > m i = i + 1 Loop Do While a(j, n) < m j = j - 1 Loop If (i <= j) Then For k = LBound(a, 2) To UBound(a, 2) wsp = a(i, k) a(i, k) = a(j, k) a(j, k) = wsp Next k i = i + 1 j = j - 1 End If Loop If (low < j) Then aQSort2_Я_А a(), n, low, j If (i < high) Then aQSort2_Я_А a(), n, i, high End Function
[/vba]
Мне больше Всего нравятся - Самый быстрый из того, что я пробовал.SLAVICK
Иногда все проще чем кажется с первого взгляда.
Сообщение отредактировал SLAVICK - Понедельник, 13.10.2014, 23:15
Работает. Прикол в том, что ексел меняет формат даты. думал догадаешься
Не то чтобы не догадался, а откровенно доверился мнению профессионала, да и забыл что из-за формата изначально чехарда имела место быть. Однако и в последнем варианте есть вопрос. Процедура в итоге выдаёт странный временной период. Изначально в файле *.csv идёт период времени со 02 января 2013 по 01 октября 2014. А в итоге имеем период с 09.12.2014 до 02.01.2013. Где он эти 19-ть несуществующих дней нашёл?
Работает. Прикол в том, что ексел меняет формат даты. думал догадаешься
Не то чтобы не догадался, а откровенно доверился мнению профессионала, да и забыл что из-за формата изначально чехарда имела место быть. Однако и в последнем варианте есть вопрос. Процедура в итоге выдаёт странный временной период. Изначально в файле *.csv идёт период времени со 02 января 2013 по 01 октября 2014. А в итоге имеем период с 09.12.2014 до 02.01.2013. Где он эти 19-ть несуществующих дней нашёл?Vostok
"Посылая кого-то в Google, Помните, завтра туда могут Послать Вас !"
Количество записей не изменилось. Я и не стал досконально проверять. доверился екселу. Чехарда возникает из-за американского фориата даты. Ексел воспринимает при первом числе до 12 как месяц, а потом как день
ексел считает что 01/10/2014 = 01.10.2014 01/14/2014 = 14.01.2014 на этот формат функция МЕСЯЦ выдаёт значение #ЗНАЧ! пришлось переформатировать дату
[vba]
Код
Option Explicit
Sub QWERT() Dim A() As String, NAME, Delimiter, i, j, C, T() As String, M(), Max As Date, Nm, TEM Delimiter = "," NAME = ActiveWorkbook.Path & "\totalpc.csv" ' читаем в массив строки A = Split(CreateObject("Scripting.FileSystemObject").Getfile(NAME).OpenasTextStream(1).ReadAll, vbNewLine) C = UBound(Split(A(i), Delimiter)) ReDim M(UBound(A), C) For i = 0 To UBound(A) - 1 ' по всем строкам T = Split(A(i), Delimiter) ' разбиваем по элементам For j = 0 To C M(i, j) = T(j) Next j If IsDate(M(i, 0)) Then T = Split(M(i, 0), "/") M(i, 0) = DateSerial(T(2), T(0), T(1)) End If Next i 'cортировка For i = 3 To UBound(A) - 1 Max = M(i, 0) Nm = i For j = i + 1 To UBound(A) If Max < M(j, 0) Then Max = M(j, 0) Nm = j End If Next j For j = 0 To C TEM = M(i, j) M(i, j) = M(Nm, j) M(Nm, j) = TEM Next j M(i, 0) = Format(M(i, 0), "dd.mm.yyyy") Next i Лист2.Cells.ClearContents Лист2.Range("A1").Resize(UBound(M), UBound(M, 2) + 1) = M MsgBox "ok", 64, "" End Sub
[/vba]
Количество записей не изменилось. Я и не стал досконально проверять. доверился екселу. Чехарда возникает из-за американского фориата даты. Ексел воспринимает при первом числе до 12 как месяц, а потом как день
ексел считает что 01/10/2014 = 01.10.2014 01/14/2014 = 14.01.2014 на этот формат функция МЕСЯЦ выдаёт значение #ЗНАЧ! пришлось переформатировать дату
[vba]
Код
Option Explicit
Sub QWERT() Dim A() As String, NAME, Delimiter, i, j, C, T() As String, M(), Max As Date, Nm, TEM Delimiter = "," NAME = ActiveWorkbook.Path & "\totalpc.csv" ' читаем в массив строки A = Split(CreateObject("Scripting.FileSystemObject").Getfile(NAME).OpenasTextStream(1).ReadAll, vbNewLine) C = UBound(Split(A(i), Delimiter)) ReDim M(UBound(A), C) For i = 0 To UBound(A) - 1 ' по всем строкам T = Split(A(i), Delimiter) ' разбиваем по элементам For j = 0 To C M(i, j) = T(j) Next j If IsDate(M(i, 0)) Then T = Split(M(i, 0), "/") M(i, 0) = DateSerial(T(2), T(0), T(1)) End If Next i 'cортировка For i = 3 To UBound(A) - 1 Max = M(i, 0) Nm = i For j = i + 1 To UBound(A) If Max < M(j, 0) Then Max = M(j, 0) Nm = j End If Next j For j = 0 To C TEM = M(i, j) M(i, j) = M(Nm, j) M(Nm, j) = TEM Next j M(i, 0) = Format(M(i, 0), "dd.mm.yyyy") Next i Лист2.Cells.ClearContents Лист2.Range("A1").Resize(UBound(M), UBound(M, 2) + 1) = M MsgBox "ok", 64, "" End Sub
Количество записей не изменилось. Я и не стал досконально проверять. доверился екселу.
Вообщем, с моими наводящими вопросами твой вариант приобретает практически Совершенные Формы (шутка). Сейчас всё грузится корректно.
Единственно, я не понял, что это за синтаксис: [vba]
Код
Лист2.Cells.ClearContents Лист2.Range("A1").Resize(UBound(M), UBound(M, 2) + 1) = M
[/vba] У меня он не срабатывает. Грузится всё на 1-ый лист, пришлось эти строки переписать.
И ещё. Если в прошлых вариантах было очевидно как начать загрузку с 3-ей или, к примеру, с 10-ой строки, то тут похоже нужно стать профессионалом по Объекту FileSystemObject, чтобы иметь возможность внести коррективы. Хотя в FileSystemObject кажется есть даже метод загрузки конкретного числа строк.
Количество записей не изменилось. Я и не стал досконально проверять. доверился екселу.
Вообщем, с моими наводящими вопросами твой вариант приобретает практически Совершенные Формы (шутка). Сейчас всё грузится корректно.
Единственно, я не понял, что это за синтаксис: [vba]
Код
Лист2.Cells.ClearContents Лист2.Range("A1").Resize(UBound(M), UBound(M, 2) + 1) = M
[/vba] У меня он не срабатывает. Грузится всё на 1-ый лист, пришлось эти строки переписать.
И ещё. Если в прошлых вариантах было очевидно как начать загрузку с 3-ей или, к примеру, с 10-ой строки, то тут похоже нужно стать профессионалом по Объекту FileSystemObject, чтобы иметь возможность внести коррективы. Хотя в FileSystemObject кажется есть даже метод загрузки конкретного числа строк.Vostok
"Посылая кого-то в Google, Помните, завтра туда могут Послать Вас !"
Сообщение отредактировал Vostok - Вторник, 14.10.2014, 14:04
Если в прошлых вариантах было очевидно как начать загрузку с 3-ей или, к примеру, с 10-ой строки, то тут похоже нужно стать профессионалом по Объекту FileSystemObject, чтобы иметь возможность внести коррективы.
Надо просто уметь читать Впрочем, я об этом уже...
Номер_Начальной_строки = 0 + 6 - 1 ' пропустим пять строк (с 0 по 4), читаем с ШЕСТОЙ Номер_конечной_строки = (Ubound(A) - 1) - 8 ' минус ВОСЕМЬ строк с конца For i = Номер_начальной строки To Номер_конечной_строки ...
Если в прошлых вариантах было очевидно как начать загрузку с 3-ей или, к примеру, с 10-ой строки, то тут похоже нужно стать профессионалом по Объекту FileSystemObject, чтобы иметь возможность внести коррективы.
Надо просто уметь читать Впрочем, я об этом уже...
Номер_Начальной_строки = 0 + 6 - 1 ' пропустим пять строк (с 0 по 4), читаем с ШЕСТОЙ Номер_конечной_строки = (Ubound(A) - 1) - 8 ' минус ВОСЕМЬ строк с конца For i = Номер_начальной строки To Номер_конечной_строки ...
Лист2.Cells.ClearContents ' очистить лист с кодовым именем Лист1 от содержимого. Лист2.Range("A1").Resize(UBound(M), UBound(M, 2) + 1) = M ' На лист с кодовым именем Лист1 начиная с ячейки "А1" на количество строк равное первой размерности массива М (UBound(M)) и количество столбцов равное второй размерности массива М (UBound(M, 2)) выгрузить сам массив М. Приём выгрузки (и загрузки ) массива одной строкой вместо организации цикла в цикле
Лист2.Cells.ClearContents ' очистить лист с кодовым именем Лист1 от содержимого. Лист2.Range("A1").Resize(UBound(M), UBound(M, 2) + 1) = M ' На лист с кодовым именем Лист1 начиная с ячейки "А1" на количество строк равное первой размерности массива М (UBound(M)) и количество столбцов равное второй размерности массива М (UBound(M, 2)) выгрузить сам массив М. Приём выгрузки (и загрузки ) массива одной строкой вместо организации цикла в циклеalex77755
Могу помочь в VB6, VBA Alex77755@mail.ru
Сообщение отредактировал alex77755 - Вторник, 14.10.2014, 18:59
как начать загрузку с 3-ей или, к примеру, с 10-ой строки
FileSystemObject может и не стоит насиловать: он вполне нормально считывает одной строкой весь файл, а Split разбивает на массив строк А. Надо просто: 1. согласовать размер выходного массива с учётом откинутых строк ReDim M(UBound(A)-2, C) откинуть нужное количество. 2. Как уже подсказали организовать цикл с нужной строки по нужную For i = 2 To UBound(A) - 2 ' по всем строкам (с учётом, что массив А начинается с индекса = 0) 3. Согласовать индексы массивов при разбиении строк. типа M(i - 2, j) = T(j) Цифра 2 поставлена условно
Цитата
как начать загрузку с 3-ей или, к примеру, с 10-ой строки
FileSystemObject может и не стоит насиловать: он вполне нормально считывает одной строкой весь файл, а Split разбивает на массив строк А. Надо просто: 1. согласовать размер выходного массива с учётом откинутых строк ReDim M(UBound(A)-2, C) откинуть нужное количество. 2. Как уже подсказали организовать цикл с нужной строки по нужную For i = 2 To UBound(A) - 2 ' по всем строкам (с учётом, что массив А начинается с индекса = 0) 3. Согласовать индексы массивов при разбиении строк. типа M(i - 2, j) = T(j) Цифра 2 поставлена условноalex77755
Могу помочь в VB6, VBA Alex77755@mail.ru
Сообщение отредактировал alex77755 - Вторник, 14.10.2014, 19:13
Лист2.Cells.ClearContents ' очистить лист с кодовым именем Лист1 от содержимого. Лист2.Range("A1").Resize(UBound(M), UBound(M, 2) + 1) = M ' На лист с кодовым именем Лист1 начиная ......
Да нет же, смысл то понятен. Не понятно откуда такое начало записи: [vba]
Код
Лист2.Cells.ClearContents
[/vba] А почему не так: [vba]
Код
Worksheets("Лист1").Cells.ClearContents
[/vba] Я просто постигать VBA начал не так давно, и нигде, ни у одного автора такой формы записи не встречал. Вот и стало интересно. Хотя, по большому счёту, теперь не так уж и важно.
Лист2.Cells.ClearContents ' очистить лист с кодовым именем Лист1 от содержимого. Лист2.Range("A1").Resize(UBound(M), UBound(M, 2) + 1) = M ' На лист с кодовым именем Лист1 начиная ......
Да нет же, смысл то понятен. Не понятно откуда такое начало записи: [vba]
Код
Лист2.Cells.ClearContents
[/vba] А почему не так: [vba]
Код
Worksheets("Лист1").Cells.ClearContents
[/vba] Я просто постигать VBA начал не так давно, и нигде, ни у одного автора такой формы записи не встречал. Вот и стало интересно. Хотя, по большому счёту, теперь не так уж и важно.Vostok
"Посылая кого-то в Google, Помните, завтра туда могут Послать Вас !"
Сообщение отредактировал Vostok - Среда, 15.10.2014, 07:51