Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1 2 След.
RSS
Как создать многомерный массив из таблички и отсортировать в нём данные
 
#1
30.11.2011 18:31:54
Есть табличка с данными (см. пример)  
 
Нужно создать многомерный массив Mass(Магазин, Расходы, Признак статьи, месяц)  
на основе этой таблички, только так чтобы в переменные массива попали только уникальные значения.  
Чтобы потом без труда вылить данные из массива в другую табличку  
 
С многомерными массивами, увы, не дружу.  
 
Для одномерного массива делал как-то так  
rowmax = Cells(Rows.Count, 4).End(xlUp).Row 'в четвёртом столбце искал макс строку  
n = rowmax - 4 'отнимал 4 строки, определив количество элементов  
 Dim mass() As Variant  
 ' ReDim mass2(n, n)  
     k = 1  
     j = 4 'данные в столбце Д  
     'загонял костцентры в массив  
     For i = 5 To rowmax 'с 5 строки    
             mass(k) =Cells(i, j).Value 'центр затрат  
             k = k + 1  
     Next i  
x = k - 1 'последнюю k убираем  
    'проверка массива на уникальность  
     For u = 1 To x 'от начала массива до конца  
        For uu = 1 To u - 1 'от начала массива до предыдущего элемента массива  
        If mass(u) = mass(uu) Then  
           mass(u) = "" 'обнулял повторяющиеся значения  
        End If  
        Next uu  
     Next u  
 
 
Наверняка есть проще способ. прошу провести мне ликбез.
 
 
 
#2
30.11.2011 18:38:52
Случайно в первом посте прикрепил файл  экселя 2007. исправляюсь.
 
 
 
#3
30.11.2011 18:44:30
в 2003-м бы посмотреть  
да и сводную не проще использовать вместо многомерного массива?
 
 
 
#4
30.11.2011 18:50:27
Сводную, ясно дело, проще сделать. но это часть большей задачи и нужно без сводной.
 
 
 
#5
30.11.2011 19:05:43
Можно взять все данные в массив:  
Dim a()  
a = [d5:i14].Value
 
Затем циклом пройтись по массиву и переложить данные в словарь, как ключ используя    
Расходы & "|" & Магазин & "|" & Признак статьи & "|" & Месяц  
а в  Item собирать суммы.  
Так автоматически уберутся повторы.    
Потом из словаря по Расходы & "|" & Магазин & "|" & Признак статьи & "|" & Месяц всегда можно получить сумму, а можно легко перекинуть в другой массив.
 
 
 
#6
30.11.2011 19:19:19
Dim a()  
a = [d5:i14].Value
 
Т.е. это будет одомерный массив? типа "Аренда", "маг1","А",100,200,300,Аренда,...  
 
Можно поподробней выложить код?  
заранее спасибо!
 
 
 
#7
30.11.2011 19:23:27
Это будет двумерный массив, как на листе: строка/колонка.  
Код через пару часов может быть, не раньше...
 
 
 
#8
30.11.2011 19:29:32
Да, потестил. таки двумерный. код я подожду, если Вас не затруднит.
 
 
 
#9
30.11.2011 20:39:28
пока додумался только до такого  
Option Base 1  
 
Sub tt()  
 Dim i As Long  
 Dim K As Long  
   
 Dim a() As Variant  
 Dim LIST()  
 Dim SUMM()  
   
 a = Range(Cells(5, 4), Cells(14, 9))  
 i = 1  
 j = 1  
 K = 1  
  ReDim LIST(UBound(a))  
  ReDim SUMM(UBound(a), 12) ' 12 месяцев  
     
  For i = LBound(a) To UBound(a)  
    LIST(K) = ""  
    For j = 1 To 6  
      If j < 4 Then  
         LIST(K) = LIST(K) & "|" & a(i, j)  
      Else  
         SUMM(i, j - 3) = a(i, j)  
      End If  
    Next j  
  Next i  
MsgBox LIST(1) & " " & SUMM(1, 3)  
     
End Sub
 
 
 
#10
30.11.2011 21:22:38
В файле 2 варианта кода на словаре - один собирает суммы в словаре, второй в привязанном массиве.  
В первом выгрузка с помощью Transpose может сбоить на большом количестве элементов, но выгрузка тут как я понимаю не главное.  
Но чуть сложнее добраться до отдельных элементов, например собрать все суммы за январь.  
Нужно перебирать все ключи, каждый разбивать на части, анализировать месяц...  
В варианте с массивом это проще - простой цикл, анализ.  
Можно количество заполненных строк (переменную x) хранить в определённом месте массива, например в последней гарантированно пустой строке в первом элементе - тогда можно перебирать не весь с запасом созданный массив, а только заполненную часть.  
Или просто готовый массив переложить одним циклом в другой, созданный уже под размер.  
 
В конце в Msgbox вывожу пример, как можно получить сумму за Транспорт|Маг3|Б|март  
 
Коды рассчитаны на подсчёт за 3 месяца.
 
 
 
#11
30.11.2011 21:34:16
Ваш вариант тоже вроде что-то делает, если K=K+1 добавить, но там уникальные не анализируются: List(1)=List(3) и т.д.
 
 
 
#12
30.11.2011 22:03:25
Раз словарь занят, будем пытать коллекцию :)  
Код кудрявый, зато динамический - можно добавлять месяцы вправо и Расходы/Магазин/ПризнакСтатьи вниз (на разных листах 2 примера). Ну и вид, как у сводной.
 
 
 
#13
30.11.2011 22:20:28
Да. K=K+1 потерял)  
 
спасибо! очень интересный вариант. совершенно другой уровень подхода. если не сложно, ответьте на несколько вопросов по коду  
 
0)     Set oDict = CreateObject("Scripting.Dictionary")  
   oDict.CompareMode = vbTextCompare  
сортируется благодаря использованному объекту? или Application.Transpose()  
 
1) a = [d3].CurrentRegion.Value эта строчка определяет массив c ячейки D3? до последней изменённой ячейки?
 
получается в а(1,4) попадает только "месяц" остальные а(1, ) пустые  
 
2) application.trim - обрезает пробелы?  
3) (--a(i, ii)) этот (-- ) оператор разделяет Key и Item?
 
 
 
#14
30.11.2011 22:45:37
0. Благодаря объекту - он (как и коллекция) не терпит повторов :)  
1. Выполните  [d3].CurrentRegion.Select
То, что пустые - это издержки, поэтому и цикл не с первого элемента.  
На практике скорее всего такой метод не пойдёт, но на код в целом это не влияет - просто можно диапазон иначе определять, методов много.  
А в этом методе подкупает количество букв :)  
2. Да, и внутри тоже до одного - в отличие от Trim(). На всякий случай, были случаи :)  
3. Бинарный минус. Переводит строку в число. На всякий случай, были случаи :)
 
 
 
#15
01.12.2011 01:13:47
Ну ради спортивного интереса сделал на ADO, ну... почти как надо :)  
как работает сам не знаю :)
Спасибо
 
 
 
#16
01.12.2011 11:31:45
Всем спасибо за помощь! визуально первый предложенный вариант проще, правда там нужно ещё добавить "вырезание ключа" на отдельные ячейки, но думаю с этим я справлюсь.  
Что хорошо в первом варианте, что есть сортировка. В остальных тоже есть чего почерпнуть полезного, но над ними надо ещё подумать).
 
 
 
#17
01.12.2011 11:58:39
Нет, сортировки в моём варианте нет - там значения в каком порядке заносятся в словарь, в таком и выгружаются.  
Сортировку итогового массива можно добавить отдельным процессом, если нужно.  
Или можно вместо словаря использовать коллекцию - там можно сортировать сразу при заполнении, и общий алгоритм схож с работой с словарём.  
Но по какому полю сортировать?  
Самый красивый вариант конечно у Николая, но уж больно кудрявый :)  
Как по мне, так мои варианты самые простые для "препарирования" - и "вырезание ключа" в первом добавить можно с помощью Split() по "|"
 
 
 
#18
01.12.2011 13:27:07
Ну, почему же, при создании ключа, указав поля в необходимом порядке, сортировка произойдёт сама по себе, насколько я понял.  
 
кстати во 2м вашем варианте  
макс теоретический объём массива    
   ReDim b(1 To UBound(a) * 3, 1 To 5)  
мне кажется должен быть больше  
   ReDim b(1 To UBound(a) * UBound(a) * UBound(a), 1 To 5)  
 
Возник такой вопрос. не могу переопределить объём массива  
 
   ReDim Preserve b(1 To x, 1 To 5) As Variant  
 
выдаёт ран-тайм ерр 9  
 
  зы по именам не знаю форумчан.  
  а самым кучерявым вариантом мне показался вариант со вставкой SQL, хотя конструкция SQL мне понята,всё же тяжеловат вариант для переваривания.
 
 
 
#19
01.12.2011 13:41:25
Я не теоретик - но сортировку словаря не замечал. Как вошло - так и вышло.  
По Preseve - можно только последнюю размерность менять, поэтому я сразу задавал на максимум.  
С максимумом размера кажется так - умножаем количество строк на количество месяцев.  
Если в строках повторов не будет - то как раз, если будут - останутся лишние незаполненные элементы.  
Или не так?...
 
 
 
#20
01.12.2011 13:59:02
Хм, таки Вы правы. значит достаточно умножить на 12  
я почему-то думал в контексте возможного количества уникальных элементов Расходы*Магазин*Признак статьи  
 
Кстати на счёт сортировки, похоже, я тоже ошибался. значит нужна сортировка. реально это сделать? отсортировать нужно два поля    
Магазин и Расходы т.е. должно получится что-то такое  
Магазин1 Аренда1  
Магазин1 Аренда2  
Магазин2 Аренда1  
Магазин2 Аренда2
 
 
 
#21
01.12.2011 16:52:37
нашёл ссыль как сортировать с помощью ADO.recordset  
http://am.rusimport.ru/MsAccess/topic.aspx?ID=471  
но прикрутить увы не смог.
 
 
 
#22
01.12.2011 17:06:09
Спец по сортировкам массивов nerv:  
http://www.planetaexcel.ru/forum.php?thread_id=7702&page_forum=2&allnum_forum=45  
Думаю сделать можно.
 
 
 
#23
01.12.2011 18:08:49
хорошая ссылка спасибо. почитав тот пост я понял, что совсем не стыдно будет банально отсортировать в экселе, особенно с учётом моих навыков программирования и поставленной задачи.
 
 
 
#24
01.12.2011 18:43:00
Да, можно тем же кодом сперва отсортировать диапазон на листе (можно записать рекордером и взять код), а потом уже этот диапазон брать в словарь.  
Или наоборот - выгрузить и отсортировать.  
Хотя сортировать массив пузырьком не очень сложно, я делал! :)  
Вероятно, можно как критерий брать не один элемент, и не два отдельных, а  
1 & "|" & 2  
а по результату двигать всю строку массива.  
Но может быть ошибаюсь, опыта мало сортировки.
 
 
 
#25
01.12.2011 19:29:19
да. так в принципе и сделал. сконкантенировал две строки в новый столбец.  
потом макрорекордером записал макрос и поправил его.  
 
Public Sub filter2(a As Range)  
   Selection.AutoFilter  
   ActiveWorkbook.ActiveSheet.AutoFilter.Sort.SortFields.Clear  
   ActiveWorkbook.ActiveSheet.AutoFilter.Sort.SortFields.Add Key:= _  
       a, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _  
       xlSortNormal  
   With ActiveWorkbook.ActiveSheet.AutoFilter.Sort  
       .Header = xlYes  
       .MatchCase = False  
       .Orientation = xlTopToBottom  
       .SortMethod = xlPinYin  
       .Apply  
   End With  
   Selection.AutoFilter  
End Sub  
 
только вышел небольшой баг. если столбец отстортирован уже снизу-вверх, то очередная сортировка приводит к обратному результату.
 
 
 
#26
01.12.2011 19:31:33
толковой справки не нашёл по этим пунктам  
 
.Orientation = xlTopToBottom  
.SortMethod = xlPinYin  
 
а   VBA как обычно не подсвечивает варианты.
 
 
 
#27
01.12.2011 23:04:21
еще одно извращение на тему ADO+Pivot :))
Спасибо
 
 
 
#28
02.12.2011 12:51:57
'находим последний заполненный столбец в строке 1  
Cl = Cells(1, Columns.Count).End(xlToLeft).Column  
задаём массив ("янв", "февр", "март", "апр", "май")  
a = Range(Cells(1, 4), Cells(1, Cl)).Value  
'шагаем от "янв" до "май"  
For i = 1 To Cl - 3  
'записываем строчку типа    
' Select t.Расходы, t.Магазин, t.янв as Сумма, 01&янв as месяц FROM Лист3 as t    
'Union  
'Select t.Расходы, t.Магазин, t.февр as Сумма, 012&февр as месяц FROM Лист3 as t  
...  
'union  
strSQL = strSQL & "SELECT T.[Расходы], T.[Магазин], T.[" & a(1, i) & "] as [сумма], '" & Format(i, "00") & a(1, i) & "' as месяц, T.[Признак статьи] FROM [Лист3$] as T union "
Next  
Select t.Расходы, t.Магазин, t.янв as Сумма, 01&янв as месяц FROM Лист3 as 'обрезаем последний Union получив таким образом обычный запрос  
strSQL = Mid(strSQL, 1, Len(strSQL) - 7)  
 
'тут дальше первый вариант продолжения  
 
' что делает Transform (запрос) pivot? это функция разворачивания суммы по мес 'в строку?  
SSql = "TRANSFORM Sum(W.сумма)" _  
& " SELECT W.Магазин, W.Расходы, Sum(W.сумма) AS [Итого]" _
& " FROM (" & StrSql & ") as W" _  
& " GROUP BY W.Магазин, W.Расходы" _  
& " PIVOT W.месяц"  
'-------- дальше по функции------  
Dim sCon As String, FieldName As String  
Dim rs As Object, cn  As Object  
Set rs = CreateObject("ADODB.Recordset")  
Set cn = CreateObject("ADODB.Connection")  
 
'если пишу FieldsName=False    
'выскакивает ошибка "T.[апр-А]не распознаётся ядром бд MS Office Access как
'допустимое имя поля или выражение видать что-то с символами"  
' равносильно "If FieldsName=True"    
If FieldsName Then FieldName = "Yes" Else FieldName = "No"  
'конвертируем тип в Long и ищем версию приложения типа 12.1, отрезаем до точки?  
'msgbox показывает 12.0  
Select Case CLng(Split(Application.Version, ".")(0))  
'если версия раньше 12 то sCon называем согласно обращения ADOBD?  
   Case Is < 12  
       sCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FilePath _  
         & ";Extended Properties=""Excel 8.0;HDR=" & FieldName & ";IMEX=1"";"  
   Case Is >= 12  
       sCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FilePath _  
       & ";Extended Properties=""Excel 12.0;HDR=" & FieldName & ";IMEX=1"";"  
End Select  
'открываем объект согласно sCon..? sCon это тип передачи данных, соединения?  
cn.Open sCon  
'если не открылось "Not cn.State = 1" - выходим из функции?  
If Not cn.State = 1 Then Exit Function  
'вычисляем запрос  
Set rs = cn.Execute(StrSql)  
 
'если FieldsName = false то OutputFieldsName = false тогда какой смысл вводить 'эту переменную? Public Function ADO_R_Dmitry(... ByVal OutputFieldsName As 'Boolean)  
 
If Not FieldsName Then OutputFieldsName = False  
'если всё же OutputFieldsName=true  
If OutputFieldsName Then  
'проходим по полям  
   For i = 0 To rs.Fields.Count - 1  
'выводим по столбцам "Offset(0," значит в точно в строку    
'смещая вправо по столбцам  
   OutputRange.Offset(0, i) = rs.Fields(i).Name  
   Next  
   'устанавливаем выделение на ячейку ниже ... и опять по циклу  
   Set OutputRange = OutputRange.Offset(1, 0)  
End If  
'не разобрался как работает  DoEvents(  
DoEvents  
OutputRange.CopyFromRecordset rs  
rs.Close:  cn.Close  
Set cn = Nothing: Set rs = Nothing  
 
зы прошу прощения за дотошность. учусь. спасибо за ответы!
 
 
 
#29
02.12.2011 13:32:07
про Transform -http://msdn.microsoft.com/en-us/library/bb208956%28v=office.12%29.aspx  
про ошибку "'если пишу FieldsName=False  
'выскакивает ошибка "T.[апр-А]не распознаётся ядром бд MS Office Access как
'допустимое имя поля или выражение видать что-то с символами"  
 
Так как Вы программно формируете строку с заголовками полей(столбцов), соответственно Вы должны также к ним и обращаться, зачастую данные храняться без заголовков, тогда можно применить False и обращаться к полям F1...Fn  
 
sCon это строка подключения на основании которой открывается соединение с источником данных (ADODB.Connection)  
 
про версию можно записать и так Val(application.version)  
смысл в том что в зависимости от версии офиса Вы используете разные драйвера.  
 
"'вычисляем запрос  
Set rs = cn.Execute(StrSql)" - открываем набор данных (Recordset)исходя из условий запроса SQL по сути это двумерный массив. (Ну не совсем конечно, но для этого случая так)  
'если не открылось "Not cn.State = 1" - выходим из функции?, все так и есть    
 
вывод данных    
если нужны заголовки то выводим их в цикле  
for i = 0 To rs.Fields.Count - 1  
'выводим по столбцам "Offset(0," значит в точно в строку  
'смещая вправо по столбцам  
OutputRange.Offset(0, i) = rs.Fields(i).Name  
Next  
если заголовки выводим то смещаемся на строку ниже  
Set OutputRange = OutputRange.Offset(1, 0)  
выгружаем данные на лист:  
OutputRange.CopyFromRecordset rs
Спасибо
 
 
 
#30
02.12.2011 13:40:42
если заинтересует последний вариант создания сводной таблицы, то нужно убивать подключение для 2007-2010 офиса примерно так:  
 
With ThisWorkbook  
For i = .Connections.Count To 1 Step -1  
   If .Connections(i).Type = xlConnectionTypeOLEDB Then .Connections(i).Delete  
Next  
End With  
Ну это если другие OLEDB подключения не используются.
Спасибо
 
 
 
Страницы: 1 2 След.
Читают тему
Наверх