Страницы: 1
RSS
Извлечение данных: только счет и сумма по клиентам
 
Здравствуйте .
Есть таблица примерно 50 000 строк
Это справка о работе банковского счета .
В прикрепленном файле выделил желтым цветом счет клиента и общую сумму проводок
на другой лист нужно скопировать только счет и общую сумму по всем клиентам
помогите пожалуйста
Главное верить....
 
Сперва ставите фильтр "начинается с Счёт:", копируете отобранное на другой лист, затем фильтр по "Итого оборот за период:" и копируете рядом.
Помог?
 
1 фильтр ок . но при 2 фильтр  "Итого оборот за период" не показывает общую сумму данные в таблице на колонке  Н  

Итого оборот за период = в А 19
а данные (сумма )   =         Н 19
Главное верить....
 
У меня всё показывает. Т.е. сперва один фильтр и вручную скопировали, затем меняем фильтр и снова копируем рядом.
Можно конечно и макросом отбирать - но мне сейчас его писать и не хочется, и некогда...
Может кто другой напишет, если нужен.
 
разобрался . показывает . Макрос был бы очень кстати .

почему кнопки "СПАСИБО"  нет
Изменено: jugador - 27.03.2015 13:17:26
Главное верить....
 
Цитата
jugador написал:
1 фильтр ок . но при 2 фильтр  "Итого оборот за период" не показывает общую сумму
Сначала отмените 1 фильтр, затем - примените 2 фильтр
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
 
Добрый день.
В прилагаемом файле есть:
1. На лист1 - фигура с побуждающей надписью. На лист2 выводится отчет.
2. Код - в единственном модуле.
Ну и тут, для интересующихся:
Код
Sub jugador()
Dim WhD As Worksheet
Dim WhR As Worksheet
Dim lngI As Long
Set WhD = Worksheets("Лист1")
Set WhR = Worksheets("Лист2")
Dim arrD()
Dim lngJ As Long
    With WhD
        lngJ = 1
        ReDim arrD(1 To .Cells(.Rows.Count, 1).End(xlUp).Row, 1 To 2)
            For lngI = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
                If InStr(1, .Cells(lngI, 1), "Счет") > 0 Then
                    arrD(lngJ, 1) = .Cells(lngI, 1)
                ElseIf InStr(1, .Cells(lngI, 1), "Итого оборот") > 0 Then
                    arrD(lngJ, 2) = .Cells(lngI, 6)
                    lngJ = lngJ + 1
                End If
            Next lngI
    End With
    With WhR
        If .Cells(.Rows.Count, 1).End(xlUp).Row > 1 Then
        .Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 2)).Clear
        End If
        .Range("A2").Resize(UBound(arrD, 2), 2) = arrD
        .Range("B:B").NumberFormat = "# ##0.00"
    End With
    
End Sub
Кому решение нужно - тот пример и рисует.
 
Или - вот так... (доп. столбик с формулой и сводная табл)
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
 
макрос чуть покороче ( и побыстрее - учитывая заявленное количкство строк)
Код
Sub cop()
    Dim ar, i&, j&, n&
    ar = [a1].CurrentRegion
    For i = 1 To UBound(ar)
        If InStr(1, ar(i, 1), "Счет:") > 0 Then
            For j = i + 2 To UBound(ar)
                If InStr(1, ar(j, 1), "за пер") > 0 Then
                    n = n + 1
                    ar(n, 1) = ar(i, 1)
                    ar(n, 2) = ar(j, 6)
                    i = j
                    Exit For
                End If
            Next j
        End If
    Next i
    Sheets.Add.Cells(1, 1).Resize(n, 2) = ar
End Sub



Изменено: Слэн - 27.03.2015 14:31:09
Живи и дай жить..
Страницы: 1
Наверх