Здравствуйте. Помогите пожалуйста с разобраться с проблемой. Написал процедуру сортировки больших массивов через arraylist. Работает, сортирует, скорость вроде неплохая (1048576 элементов менее, чем за минуту ), но возникла проблема при выгрузке дат на лист. Выгружаются они в текстовом формате, чтобы получить числовой формат я заменяю точки на / (в 320 строке), но после замены оказывается, что день и месяц меняются местами, и некоторые даты (те, в которых перед первой точкой число более 12) остались текстом. Заменяю вручную через - все заменяется и получаются правильные даты. Помогите разобраться в причинах такого поведения. В принципе если 140 строку заменить на[vba]
Код
ALD.Add cell.Formula
[/vba] и 320 на[vba]
Код
.Numberformat = "dd.mm.yyyy"
[/vba] то все работает правильно, но я хочу понять почему не получается сделать это заменой. Спасибо
[vba]
Код
Option Explicit Const cnt = 65536 Sub SortRangeAL() '--------------------------------------------------------------------------------------- ' Procedure : SortRangeAL ' Author : krosav4ig ' Date : 27.10.2014 ' Purpose : '--------------------------------------------------------------------------------------- ' 'Dim ALS As New ArrayList, ALN As New ArrayList, ALD As New ArrayList, AL1 As New ArrayList 'mscorlib.tlb Dim ALS, ALN, ALD, AL1 10 Set ALS = CreateObject("System.Collections.ArrayList") 20 Set ALN = CreateObject("System.Collections.ArrayList") 30 Set AL1 = CreateObject("System.Collections.ArrayList") 40 Set ALD = CreateObject("System.Collections.ArrayList") Dim Lists(2)
Dim Rng As Range, cell As Range Dim i%, n&, j%, k&, m& 'Dim t#, t1#, t2#, t3#
50 On Error GoTo SortRange_Error 60 Set Rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.[A:A]) 70 Rng.Offset(, 1).Clear 80 With Application: .ScreenUpdating = 0: .EnableEvents = 0: End With 't = timer 90 For Each cell In Rng 100 If Len(cell.Value) Then 110 If IsNumeric(cell.Value) Then 120 ALN.Add cell.Value 130 ElseIf IsDate(cell.Value) Then 140 ALD.Add cell.Value 150 Else 160 ALS.Add cell.Value 170 End If 180 End If 190 Next 't1 = timer - t: t2 = timer 200 ALS.Sort: ALD.Sort: ALN.Sort 't2 = timer - t2: t3 = timer 210 Set Lists(0) = ALD: Set Lists(1) = ALN: Set Lists(2) = ALS 220 For j = 0 To 2 230 i = 0 240 If Lists(j).Count Then 250 k = k + IIf(j, Lists(j + (j > 0)).Count, 0) 260 Do 270 n = Application.Min(cnt, Lists(j).Count - i * cnt) 280 Set AL1 = Lists(j).getrange(i * cnt - IIf(i, 1, 0), n) 290 With Rng(1).Offset(k + i * cnt, 1).Resize(n) 300 .Formula = Application.Transpose(AL1.Toarray) 310 If j = 0 Then 320 .Replace ".", "/" '<--- шо-то тут не то 330 End If 340 m = .Count 350 End With 360 i = i + 1 370 Loop While n = cnt And i < 16 380 End If 390 Next 't3 = timer - t3: t = timer - t 'MsgBox "Запись значений в ArrayList - " & t1 & Chr(10) & "Непосредственно сортировка - " & t2 & Chr(10) & _ "Вывод в диапазон - " & t3 & Chr(10) & "Итого - " & t 400 Erase Lists: Set ALS = Nothing: Set ALN = ALS: Set AL1 = ALS
SortRange_Error: 410 With Application: .ScreenUpdating = 1: .EnableEvents = 1: End With 420 If Err.Number Then MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Sub SortRangeAL on line " & Erl End Sub
[/vba]
Здравствуйте. Помогите пожалуйста с разобраться с проблемой. Написал процедуру сортировки больших массивов через arraylist. Работает, сортирует, скорость вроде неплохая (1048576 элементов менее, чем за минуту ), но возникла проблема при выгрузке дат на лист. Выгружаются они в текстовом формате, чтобы получить числовой формат я заменяю точки на / (в 320 строке), но после замены оказывается, что день и месяц меняются местами, и некоторые даты (те, в которых перед первой точкой число более 12) остались текстом. Заменяю вручную через - все заменяется и получаются правильные даты. Помогите разобраться в причинах такого поведения. В принципе если 140 строку заменить на[vba]
Код
ALD.Add cell.Formula
[/vba] и 320 на[vba]
Код
.Numberformat = "dd.mm.yyyy"
[/vba] то все работает правильно, но я хочу понять почему не получается сделать это заменой. Спасибо
[vba]
Код
Option Explicit Const cnt = 65536 Sub SortRangeAL() '--------------------------------------------------------------------------------------- ' Procedure : SortRangeAL ' Author : krosav4ig ' Date : 27.10.2014 ' Purpose : '--------------------------------------------------------------------------------------- ' 'Dim ALS As New ArrayList, ALN As New ArrayList, ALD As New ArrayList, AL1 As New ArrayList 'mscorlib.tlb Dim ALS, ALN, ALD, AL1 10 Set ALS = CreateObject("System.Collections.ArrayList") 20 Set ALN = CreateObject("System.Collections.ArrayList") 30 Set AL1 = CreateObject("System.Collections.ArrayList") 40 Set ALD = CreateObject("System.Collections.ArrayList") Dim Lists(2)
Dim Rng As Range, cell As Range Dim i%, n&, j%, k&, m& 'Dim t#, t1#, t2#, t3#
50 On Error GoTo SortRange_Error 60 Set Rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.[A:A]) 70 Rng.Offset(, 1).Clear 80 With Application: .ScreenUpdating = 0: .EnableEvents = 0: End With 't = timer 90 For Each cell In Rng 100 If Len(cell.Value) Then 110 If IsNumeric(cell.Value) Then 120 ALN.Add cell.Value 130 ElseIf IsDate(cell.Value) Then 140 ALD.Add cell.Value 150 Else 160 ALS.Add cell.Value 170 End If 180 End If 190 Next 't1 = timer - t: t2 = timer 200 ALS.Sort: ALD.Sort: ALN.Sort 't2 = timer - t2: t3 = timer 210 Set Lists(0) = ALD: Set Lists(1) = ALN: Set Lists(2) = ALS 220 For j = 0 To 2 230 i = 0 240 If Lists(j).Count Then 250 k = k + IIf(j, Lists(j + (j > 0)).Count, 0) 260 Do 270 n = Application.Min(cnt, Lists(j).Count - i * cnt) 280 Set AL1 = Lists(j).getrange(i * cnt - IIf(i, 1, 0), n) 290 With Rng(1).Offset(k + i * cnt, 1).Resize(n) 300 .Formula = Application.Transpose(AL1.Toarray) 310 If j = 0 Then 320 .Replace ".", "/" '<--- шо-то тут не то 330 End If 340 m = .Count 350 End With 360 i = i + 1 370 Loop While n = cnt And i < 16 380 End If 390 Next 't3 = timer - t3: t = timer - t 'MsgBox "Запись значений в ArrayList - " & t1 & Chr(10) & "Непосредственно сортировка - " & t2 & Chr(10) & _ "Вывод в диапазон - " & t3 & Chr(10) & "Итого - " & t 400 Erase Lists: Set ALS = Nothing: Set ALN = ALS: Set AL1 = ALS
SortRange_Error: 410 With Application: .ScreenUpdating = 1: .EnableEvents = 1: End With 420 If Err.Number Then MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Sub SortRangeAL on line " & Erl End Sub
а может у вас батарейка 2032 сдохла и время сбилось? хотя, тут скорее всего дело в чем-то другом, если это была бы батарейка, то время бы шло.
а может у вас батарейка 2032 сдохла и время сбилось? хотя, тут скорее всего дело в чем-то другом, если это была бы батарейка, то время бы шло.krosav4ig
Alex_ST, свойство Creation date excel записывает сразу при создании книги (открытия excel) еще до сохранения и никогда не перезаписывается, свойство файла DateCreated записывается при первом сохранении этого файла. Если открыть старый файл и сохранить его как, то запишется только DateCreated. Вот и вся магия
Alex_ST, свойство Creation date excel записывает сразу при создании книги (открытия excel) еще до сохранения и никогда не перезаписывается, свойство файла DateCreated записывается при первом сохранении этого файла. Если открыть старый файл и сохранить его как, то запишется только DateCreated. Вот и вся магияkrosav4ig
-количество непустых значений во 2 строке (количество клиентов +1)
Код
(СТРОКА(ДВССЫЛ("$1:$"&СЧЁТЗ($2:$2)))-1)
-возвращает массив {0:1:2:3}, его же умножаем на 8 (шаг сдвига вправо) и получаем массив {0:8:16:24} (на столько ячеек вправо от J5 нужно сдвигаться, чтобы получать значения из необходимых столбцов всех клиентов)
считает количество ненулевых значений из выбранных формула
Код
МАКС(1;значение)
нужна чтобы избежать деления на 0 вы можете посмотреть как вычисляются отдельные фрагменты формулы, для этого нужно в строке формул выделить нужный фрагмент и нажать F9 Ну вот вроде и все
ну дык это и есть формула массива, вводится комбинацией Ctrl+Shift+Enter
-количество непустых значений во 2 строке (количество клиентов +1)
Код
(СТРОКА(ДВССЫЛ("$1:$"&СЧЁТЗ($2:$2)))-1)
-возвращает массив {0:1:2:3}, его же умножаем на 8 (шаг сдвига вправо) и получаем массив {0:8:16:24} (на столько ячеек вправо от J5 нужно сдвигаться, чтобы получать значения из необходимых столбцов всех клиентов)
считает количество ненулевых значений из выбранных формула
Код
МАКС(1;значение)
нужна чтобы избежать деления на 0 вы можете посмотреть как вычисляются отдельные фрагменты формулы, для этого нужно в строке формул выделить нужный фрагмент и нажать F9 Ну вот вроде и всеkrosav4ig
=ЕСЛИ(в ячейке B2 есть значение;ЕСЛИ(в столбце B в строках от 1 до предыдущей было B2;"";вывести сумму значений из столбца C соответствующих B2);"")
удалять только макросом, без макроса можно только отфильтровать или использовать сводные Richman, потому что нужно, чтобы сумма по коду считалась только 1 раз и не дублировалась в строках ниже
Index,
Код
=ЕСЛИ(в ячейке B2 есть значение;ЕСЛИ(в столбце B в строках от 1 до предыдущей было B2;"";вывести сумму значений из столбца C соответствующих B2);"")
удалять только макросом, без макроса можно только отфильтровать или использовать сводные Richman, потому что нужно, чтобы сумма по коду считалась только 1 раз и не дублировалась в строках нижеkrosav4ig
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'включаем действие по клику Cancel = 0 On Error GoTo err 'если произойдет какая-нибудь ошибка, выполнить последнюю строку кода If Not Intersect(Target, Range("K4:K5000")) Is Nothing Then 'включаем макрос для данного диапазона ячеек With Target(1, 1) 'указываем, с какой ячейкой работать макросу With Application: .ScreenUpdating = 0: End With 'оптимизация производительности макроса Dim Name$: Name = Application.UserName 'задаём переменную Name, содержащую имя пользователя 'волшебство начинается Dim L&: L = Len(.Value) .Characters(L).Insert Right(.Value, 1) & IIf(L, vbLf, "") & Now & " " & Name & ": " Dim L2&: L2 = Len(Target.Characters.Text) Dim AL: Set AL = CreateObject("System.Collections.ArrayList") AL.Add "Иванов А.": AL.Add "Андреев П.": AL.Add "Васьков А." .Characters(L + 1, L2 - L - 1).Font.Color = IIf(AL.contains(Name), vbBlue, vbBlack) 'выделяем дату\время\ФИО в комментарии определённого пользователя Set AL = Nothing 'волшебство закончилось ; ) With .Characters(L + 1, L2 - L).Font .Name = Application.StandardFont: .Bold = 0: .Italic = 0 .Size = Application.StandardFontSize: .Strikethrough = 0 .Subscript = 0: .Superscript = 0: .ThemeFont = 0 .TintAndShade = 0: .Underline = -4142 .OutlineFont = 0: .Shadow = 0: .FontStyle = "обычный" End With .Characters(L2).Font.ColorIndex = xlAutomatic End With End If err: 'следующая строка дожна быть обязательно выполнена With Application: .ScreenUpdating = 1: .EnableEvents = 1: End With 'оптимизация производительности макроса End Sub
[/vba]
[vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'включаем действие по клику Cancel = 0 On Error GoTo err 'если произойдет какая-нибудь ошибка, выполнить последнюю строку кода If Not Intersect(Target, Range("K4:K5000")) Is Nothing Then 'включаем макрос для данного диапазона ячеек With Target(1, 1) 'указываем, с какой ячейкой работать макросу With Application: .ScreenUpdating = 0: End With 'оптимизация производительности макроса Dim Name$: Name = Application.UserName 'задаём переменную Name, содержащую имя пользователя 'волшебство начинается Dim L&: L = Len(.Value) .Characters(L).Insert Right(.Value, 1) & IIf(L, vbLf, "") & Now & " " & Name & ": " Dim L2&: L2 = Len(Target.Characters.Text) Dim AL: Set AL = CreateObject("System.Collections.ArrayList") AL.Add "Иванов А.": AL.Add "Андреев П.": AL.Add "Васьков А." .Characters(L + 1, L2 - L - 1).Font.Color = IIf(AL.contains(Name), vbBlue, vbBlack) 'выделяем дату\время\ФИО в комментарии определённого пользователя Set AL = Nothing 'волшебство закончилось ; ) With .Characters(L + 1, L2 - L).Font .Name = Application.StandardFont: .Bold = 0: .Italic = 0 .Size = Application.StandardFontSize: .Strikethrough = 0 .Subscript = 0: .Superscript = 0: .ThemeFont = 0 .TintAndShade = 0: .Underline = -4142 .OutlineFont = 0: .Shadow = 0: .FontStyle = "обычный" End With .Characters(L2).Font.ColorIndex = xlAutomatic End With End If err: 'следующая строка дожна быть обязательно выполнена With Application: .ScreenUpdating = 1: .EnableEvents = 1: End With 'оптимизация производительности макроса End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
), но возникла проблема при выгрузке дат на лист. Выгружаются они в текстовом формате, чтобы получить числовой формат я заменяю точки на / (в 320 строке), но после замены оказывается, что день и месяц меняются местами, и некоторые даты (те, в которых перед первой точкой число более 12) остались текстом. Заменяю вручную через - все заменяется и получаются правильные даты. Помогите разобраться в причинах такого поведения. В принципе если 140 строку заменить на[vba]
, или тему вообще закроют
