Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 15.03.2011, 16:45   #1
igsxor
Пользователь
 
Регистрация: 15.03.2011
Сообщений: 35
Вопрос макрос.Чтение данных из 1 табл и результат действия в 2 таблице.

Добрый день.
Подскажите пожалуйста каким способом можно решить данный вопрос.
Из 1ой таблицы нужно выбрать данные из столбца rashod(данные суммируются между собой по отдельному человеку(целочисленный тип данных numls),суммируются отдельно синие строки и отдельно красные.

Файлы Excel прикреплены к письму.В 2 ой таблице примерный результат,то что нужно получить,если такое возможно,конечно.Представленные примеры урезанные,т.к. таблицы состоят из более 300 строк.

Если такой способ возможен,подскажите как реализовать его.

Последний раз редактировалось igsxor; 15.03.2011 в 16:45. Причина: не прикрепил файл
igsxor вне форума Ответить с цитированием
Старый 15.03.2011, 16:49   #2
igsxor
Пользователь
 
Регистрация: 15.03.2011
Сообщений: 35
По умолчанию

Прошу прощения забыл прикрепить файл.
архив винрар,excel 2007
Вложения
Тип файла: rar for_prog_forum.rar (14.6 Кб, 17 просмотров)

Последний раз редактировалось igsxor; 15.03.2011 в 20:27.
igsxor вне форума Ответить с цитированием
Старый 15.03.2011, 17:19   #3
Hugo121
Старожил
 
Регистрация: 11.05.2010
Сообщений: 5,166
По умолчанию

Чувствую, за основу можно взять этот код:

Код:
http://www.planetaexcel.ru/forum.php?thread_id=24221
с помощью Николая
Option Explicit

Sub Otbor()
    Dim a(), b, cc, oDict As Object, i As Long, ii As Long, j As Long, k As Long, temp As String

    a = Range("B2:D" & Range("B" & Rows.Count).End(xlUp).Row).Value
    ReDim b(1 To UBound(a), 1 To 3)

    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(a)
            temp = IIf(Trim(a(i, 2)) < Trim(a(i, 3)), UCase(Trim(a(i, 2)) & "|" & Trim(a(i, 3))), UCase(Trim(a(i, 3)) & "|" & Trim(a(i, 2))))
            If Not .Exists(temp) Then
                j = j + 1: .Item(temp) = j
                b(j, 1) = Split(temp, "|")(0)
                b(j, 2) = Split(temp, "|")(1)
                b(j, 3) = a(i, 1)
            Else
                k = .Item(temp)
                b(k, 3) = b(k, 3) + a(i, 1)
            End If
        Next
    End With

    With ThisWorkbook.Worksheets(1)
        .Range("L5:n5").Resize(UBound(b)) = b
    End With

End Sub
Пример переложите - там даже не 300, а 2 раза по 7300 строк
webmoney: E265281470651 Z422237915069 R418926282008
Hugo121 вне форума Ответить с цитированием
Старый 15.03.2011, 17:38   #4
Hugo121
Старожил
 
Регистрация: 11.05.2010
Сообщений: 5,166
По умолчанию

Вот так например (подготовьте чистый второй лист):
Код:
Option Explicit

Sub Otbor()
    Dim a(), b, cc, oDict As Object, i As Long, ii As Long, j As Long, k As Long, temp As String

    a = Range("A2:I" & Range("A" & Rows.Count).End(xlUp).Row).Value
    ReDim b(1 To UBound(a), 1 To 3)

    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(a)
            temp = a(i, 1) & "|" & a(i, 5)
            If Not .Exists(temp) Then
                j = j + 1: .Item(temp) = j
                b(j, 1) = Split(temp, "|")(0)
                b(j, 2) = Split(temp, "|")(1)
                b(j, 3) = a(i, 9)
            Else
                k = .Item(temp)
                b(k, 3) = b(k, 3) + a(i, 9)
            End If
        Next
    End With

    With ThisWorkbook.Worksheets(2)
        .Range("A1:C1").Resize(j) = b
    End With

End Sub
Выход немного отличается от заказанного, но сейчас подгонять некогда.
webmoney: E265281470651 Z422237915069 R418926282008

Последний раз редактировалось Hugo121; 15.03.2011 в 17:56. Причина: Изменил выгрузку - так правильнее и быстрее
Hugo121 вне форума Ответить с цитированием
Старый 15.03.2011, 17:57   #5
igsxor
Пользователь
 
Регистрация: 15.03.2011
Сообщений: 35
По умолчанию

Спасибо,перепутал когда формулировал вопрос.
igsxor вне форума Ответить с цитированием
Старый 15.03.2011, 17:58   #6
Hugo121
Старожил
 
Регистрация: 11.05.2010
Сообщений: 5,166
По умолчанию

Исправил в коде выше выгрузку - не Resize(UBound(b)) , а Resize(j)
Так лучше, хотя результат с виду не изменился.
Сейчас глянул - там "|" и Split лишнее, можно и без этого обойтись:
Код:
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(a)
            temp = a(i, 1) & a(i, 5)
            If Not .Exists(temp) Then
                j = j + 1: .Item(temp) = j
                b(j, 1) = a(i, 1)
                b(j, 2) = a(i, 5)
                b(j, 3) = a(i, 9)
            Else
                k = .Item(temp)
                b(k, 3) = b(k, 3) + a(i, 9)
            End If
        Next
    End With
, но пусть...
webmoney: E265281470651 Z422237915069 R418926282008

Последний раз редактировалось Hugo121; 15.03.2011 в 18:06.
Hugo121 вне форума Ответить с цитированием
Старый 15.03.2011, 18:04   #7
igsxor
Пользователь
 
Регистрация: 15.03.2011
Сообщений: 35
По умолчанию

Цитата:
Сообщение от Hugo121 Посмотреть сообщение
Исправил в коде выше выгрузку - не Resize(UBound(b)) , а Resize(j)
Так лучше, хотя результат с виду не изменился.
А какой именно код использовать?
И если Вас не затруднит прокоментировать,то что он делает.
Дело в том,что только только начал читать книгу по VB Excel Peter Aitken.
igsxor вне форума Ответить с цитированием
Старый 15.03.2011, 18:07   #8
Hugo121
Старожил
 
Регистрация: 11.05.2010
Сообщений: 5,166
По умолчанию

Через пару часов могу прокомментировать.
webmoney: E265281470651 Z422237915069 R418926282008
Hugo121 вне форума Ответить с цитированием
Старый 15.03.2011, 19:03   #9
igsxor
Пользователь
 
Регистрация: 15.03.2011
Сообщений: 35
Вопрос

Цитата:
Сообщение от Hugo121 Посмотреть сообщение
Исправил в коде выше выгрузку - не Resize(UBound(b)) , а Resize(j)
Так лучше, хотя результат с виду не изменился.
Сейчас глянул - там "|" и Split лишнее, можно и без этого обойтись:
Код:
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(a)
            temp = a(i, 1) & a(i, 5)
            If Not .Exists(temp) Then
                j = j + 1: .Item(temp) = j
                b(j, 1) = a(i, 1)
                b(j, 2) = a(i, 5)
                b(j, 3) = a(i, 9)
            Else
                k = .Item(temp)
                b(k, 3) = b(k, 3) + a(i, 9)
            End If
        Next
    End With
, но пусть...


Записал макрос,но при исполнении редактор VB выдаёт ошибку:

Код:
Option Explicit
Sub Otbor()
'
' Viborka_hc Ìàêðîñ
' Âûáèðàåò è ñóììèðóåò çíà÷åíèÿ ïîêàçàòåëåé ãîð è õîë âîäû
'
    Dim a(), b, cc, oDict As Object, i As Long, ii As Long, j As Long, k As Long, temp As String

    a = Range("A2:I" & Range("A" & Rows.Count).End(xlUp).Row).Value
    ReDim b(1 To UBound(a), 1 To 3)

    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(a)
            temp = a(i, 1) & a(i, 5)
            If Not .Exists(temp) Then
                j = j + 1: .Item(temp) = j
                b(j, 1) = a(i, 1)
                b(j, 2) = a(i, 5)
                b(j, 3) = a(i, 9)
            Else
                k = .Item(temp)
                b(k, 3) = b(k, 3) + a(i, 9)
            End If
        Next
    End With
'
' Application.Run "PERSONAL.XLSB!Viborka_hc"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Documents and Settings\dell_xp\Application Data\Microsoft\Excel\XLSTART\PERSONAL.XLSB" _
        , FileFormat:=xlExcel12, CreateBackup:=False
    Application.Left = 214
    Application.Top = 25.75
End Sub
igsxor вне форума Ответить с цитированием
Старый 15.03.2011, 20:45   #10
Hugo121
Старожил
 
Регистрация: 11.05.2010
Сообщений: 5,166
По умолчанию

Не понятно, зачем сохранять, да и ещё как XLSTART\PERSONAL.XLSB?
И самое главное выкинули - где выгрузка полученного массива?
webmoney: E265281470651 Z422237915069 R418926282008
Hugo121 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Макрос группировки данных в таблице magana Microsoft Office Excel 1 28.01.2011 23:52
Обновление данных из табл в др. Ал3 Microsoft Office Access 1 04.07.2010 00:27
Результат перевода из 10й сис-мы в 16-ю занести в табл(10-е число - 16), до тех пор пока не будет введено Maemi_IT Assembler - Ассемблер (FASM, MASM, WASM, NASM, GoASM, Gas, RosAsm, HLA) и не рекомендуем TASM 1 11.01.2010 21:27
Кол-во данных в таблице dani92 БД в Delphi 1 02.04.2009 07:58
Как выпонить действия по двойному слику на созданной таблице Tiolic Общие вопросы Delphi 2 21.06.2007 09:53