Здравствуйте Ув. форумчане. Никак не могу справиться с такой задачей: Таблица вида: Дата платежа Зачислено в валюте договора Номер телефона 05.10.2010 1300 9031111111 05.10.2010 1400 9052222222 05.10.2010 1000 9031111111 05.10.2010 3800 9052222222 05.10.2010 3800 9657777777 05.10.2010 3800 9657777777 05.10.2010 3800 9099999999 05.10.2010 3800 9052222222
Как мне сделать так чтобы повторяющиеся номера "испарились", а суммы по этим номерам сплюсовались в соотв. ячейку по соотв номеру?
Спасибо.
Здравствуйте Ув. форумчане. Никак не могу справиться с такой задачей: Таблица вида: Дата платежа Зачислено в валюте договора Номер телефона 05.10.2010 1300 9031111111 05.10.2010 1400 9052222222 05.10.2010 1000 9031111111 05.10.2010 3800 9052222222 05.10.2010 3800 9657777777 05.10.2010 3800 9657777777 05.10.2010 3800 9099999999 05.10.2010 3800 9052222222
Как мне сделать так чтобы повторяющиеся номера "испарились", а суммы по этим номерам сплюсовались в соотв. ячейку по соотв номеру?
1. В сводной таблице данные у меня почему-то не плюсуются по суммам, а просто откидываются, кроме первого значения. 2. Второй вариант я вообще не понял... Прошу прощения за свою непонятливость.
1. В сводной таблице данные у меня почему-то не плюсуются по суммам, а просто откидываются, кроме первого значения. 2. Второй вариант я вообще не понял... Прошу прощения за свою непонятливость.Evgen
1. В сводной таблице данные у меня почему-то не плюсуются по суммам, а просто откидываются, кроме первого значения. 2. Второй вариант я вообще не понял...
1. Как это "откидываются"? Посмотрите пример: телефон 9031111111 Зачислено в валюте договора 1300 и 1000 - в сводной 2300. Что не получается? 2. Что не понятно во втором варианте? Файл смотрели?
Quote (Evgen)
1. В сводной таблице данные у меня почему-то не плюсуются по суммам, а просто откидываются, кроме первого значения. 2. Второй вариант я вообще не понял...
1. Как это "откидываются"? Посмотрите пример: телефон 9031111111 Зачислено в валюте договора 1300 и 1000 - в сводной 2300. Что не получается? 2. Что не понятно во втором варианте? Файл смотрели?Serge_007
В Вашем варианте именно 2300 получается, а у меня остается 1300, а вторая сумма просто исчезает.
Quote
Что не понятно во втором варианте? Файл смотрели?
Я не могу понять куда подставлять эти формулы. Таблица, которую я хочу привести в нормальный вид имеет гораздо больше строк, нежели я указал в примере. Файл безусловно смотрел, но скомпилировать его под себя не хватает умений.
Готов заплатить за создание скрипта. icq 327157637
Quote
Как это "откидываются"?
В Вашем варианте именно 2300 получается, а у меня остается 1300, а вторая сумма просто исчезает.
Quote
Что не понятно во втором варианте? Файл смотрели?
Я не могу понять куда подставлять эти формулы. Таблица, которую я хочу привести в нормальный вид имеет гораздо больше строк, нежели я указал в примере. Файл безусловно смотрел, но скомпилировать его под себя не хватает умений.
Готов заплатить за создание скрипта. icq 327157637
Если файлы большие и надо сделать процедуру полностью автоматической - можно написать макрос: данные в массив, затем извлекаем уникальные в словарь или коллекцию, а в Item собираем сумму. В итоге выгружаем результат на лист - этот или другой. Например так:
Code
Option Explicit
Sub Otbor() Dim a(), oDict As Object, i As Long, temp As String
a = Range("a1:c" & Range("C" & Rows.Count).End(xlUp).Row).Value
Set oDict = CreateObject("Scripting.Dictionary") For i = 1 To UBound(a) temp = Trim(a(i, 3)) If Not oDict.Exists(temp) Then oDict.Add temp, CStr(a(i, 2)) Else oDict.Item(temp) = CStr(--oDict.Item(temp) + a(i, 2)) End If Next
With ThisWorkbook.Worksheets(1) .Range("D1").Resize(oDict.Count) = Application.Transpose(oDict.keys) .Range("E1").Resize(oDict.Count) = Application.Transpose(oDict.items) End With
End Sub
На массивах с числом строк 65537 и более Transpose работать не будет. Тогда суммы и значения можно собирать не в словарь, а в другой массив. А словарь использовать только для идентификации уникальных значений, а как Item брать номер позиции во втором массиве.
Если файлы большие и надо сделать процедуру полностью автоматической - можно написать макрос: данные в массив, затем извлекаем уникальные в словарь или коллекцию, а в Item собираем сумму. В итоге выгружаем результат на лист - этот или другой. Например так:
Code
Option Explicit
Sub Otbor() Dim a(), oDict As Object, i As Long, temp As String
a = Range("a1:c" & Range("C" & Rows.Count).End(xlUp).Row).Value
Set oDict = CreateObject("Scripting.Dictionary") For i = 1 To UBound(a) temp = Trim(a(i, 3)) If Not oDict.Exists(temp) Then oDict.Add temp, CStr(a(i, 2)) Else oDict.Item(temp) = CStr(--oDict.Item(temp) + a(i, 2)) End If Next
With ThisWorkbook.Worksheets(1) .Range("D1").Resize(oDict.Count) = Application.Transpose(oDict.keys) .Range("E1").Resize(oDict.Count) = Application.Transpose(oDict.items) End With
End Sub
На массивах с числом строк 65537 и более Transpose работать не будет. Тогда суммы и значения можно собирать не в словарь, а в другой массив. А словарь использовать только для идентификации уникальных значений, а как Item брать номер позиции во втором массиве.Hugo
На массивах с числом строк 65537 и более Transpose работать не будет
Игорь, ты не в курсе: это только для 2003-го с его ограничением как раз в 65536 строк (тогда это явно не глюк Application.Transpose, а логичное ограничение) или и на более поздних (2007, 2010) Ёкселях то же самое?
Quote (Hugo)
На массивах с числом строк 65537 и более Transpose работать не будет
Игорь, ты не в курсе: это только для 2003-го с его ограничением как раз в 65536 строк (тогда это явно не глюк Application.Transpose, а логичное ограничение) или и на более поздних (2007, 2010) Ёкселях то же самое?Alex_ST
С уважением, Алексей MS Excel 2003 - the best!!!
Сообщение отредактировал Alex_ST - Понедельник, 25.10.2010, 09:21
, я бы всё-таки на всякий случай добавил в конце Set oDict = Nothing чтобы память очищать. Или чуть подправил твой код так, как научили старшие товарищи на Планете:
Code
Sub Otbor2() Dim Arr(), i&, temp$ Arr = Range("A1:C" & Range("C" & Rows.Count).End(xlUp).Row).Value With Create_Object("Scripting.Dictionary") For i = 1 To UBound(Arr) temp = Trim(CStr(Arr(i, 3))) If Not .Exists(temp) Then .Add temp, CStr(Arr(i, 2)) Else .Item(temp) = CStr(--.Item(temp) + Arr(i, 2)) End If Next ThisWorkbook.Worksheets(1).Range("D1").Resize(.Count) = Application.Transpose(.Keys) ThisWorkbook.Worksheets(1).Range("E1").Resize(.Count) = Application.Transpose(.Items) End With End Sub
P.S. Create_Object, естественно, нужно писать слитно, но шизоидная система безопасности интранета на работе это не пропускает!
А по поводу твоего кода, т.к.
Quote (Evgen)
Они разные от 25 кб до нескольких мб
, я бы всё-таки на всякий случай добавил в конце Set oDict = Nothing чтобы память очищать. Или чуть подправил твой код так, как научили старшие товарищи на Планете:
Code
Sub Otbor2() Dim Arr(), i&, temp$ Arr = Range("A1:C" & Range("C" & Rows.Count).End(xlUp).Row).Value With Create_Object("Scripting.Dictionary") For i = 1 To UBound(Arr) temp = Trim(CStr(Arr(i, 3))) If Not .Exists(temp) Then .Add temp, CStr(Arr(i, 2)) Else .Item(temp) = CStr(--.Item(temp) + Arr(i, 2)) End If Next ThisWorkbook.Worksheets(1).Range("D1").Resize(.Count) = Application.Transpose(.Keys) ThisWorkbook.Worksheets(1).Range("E1").Resize(.Count) = Application.Transpose(.Items) End With End Sub
P.S. Create_Object, естественно, нужно писать слитно, но шизоидная система безопасности интранета на работе это не пропускает!
Про Transpose говорят, что оно так и осталось. Но на 2000 ещё хуже - глючит у меня и на меньших объёмах, на каких точно сказать не могу. Но были случаи, когда один и тот же код на 2003 работал, а на 2000 нет. И именно на Transpose выкидывало ошибку.
Про Transpose говорят, что оно так и осталось. Но на 2000 ещё хуже - глючит у меня и на меньших объёмах, на каких точно сказать не могу. Но были случаи, когда один и тот же код на 2003 работал, а на 2000 нет. И именно на Transpose выкидывало ошибку.Hugo
Интересно, а с использованием API можно как-нибудь сделать транспонирование массива? Конечно, стандартными VBA-циклами - нет проблем, но м-е-е-д-л-е-н-н-о будет, наверное. Я вот писАл как-то:
Code
Function TrArr(Arr) 'возвращает транспонированный 2D-массив Dim L1&, U1&: L1 = LBound(Arr, 1): U1 = UBound(Arr, 1) Dim L2&, U2&: L2 = LBound(Arr, 2): U2 = UBound(Arr, 2) Dim tArr(): ReDim tArr(L2 To U2, L1 To U1) Dim RR&, CC& For RR = L1 To U1 For CC = L2 To U2 tArr(CC, RR) = Arr(RR, CC) Next CC Next RR TrArr = tArr End Function
Интересно было бы сравнить по скорости с Application.Transpose... Что-то не соображу никак, как сравнивать, ведь Application.Transpose возвращает на лист... Или не обязательно - можно и в массив?
Интересно, а с использованием API можно как-нибудь сделать транспонирование массива? Конечно, стандартными VBA-циклами - нет проблем, но м-е-е-д-л-е-н-н-о будет, наверное. Я вот писАл как-то:
Code
Function TrArr(Arr) 'возвращает транспонированный 2D-массив Dim L1&, U1&: L1 = LBound(Arr, 1): U1 = UBound(Arr, 1) Dim L2&, U2&: L2 = LBound(Arr, 2): U2 = UBound(Arr, 2) Dim tArr(): ReDim tArr(L2 To U2, L1 To U1) Dim RR&, CC& For RR = L1 To U1 For CC = L2 To U2 tArr(CC, RR) = Arr(RR, CC) Next CC Next RR TrArr = tArr End Function
Интересно было бы сравнить по скорости с Application.Transpose... Что-то не соображу никак, как сравнивать, ведь Application.Transpose возвращает на лист... Или не обязательно - можно и в массив?Alex_ST
С уважением, Алексей MS Excel 2003 - the best!!!
Сообщение отредактировал Alex_ST - Понедельник, 25.10.2010, 12:26