Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Создание обьявления с списком должников
 
#1
03.11.2020 11:49:50
День добрый

ребят стоит задача создать уведомление на определенный адрес с указанием таблицы в которой перечень квартир и сумы долга на каждую из них.
адресов уйма и  просто копировать вставлять перечень квартир тратится очень много времени...

может есть способ попроще ( что то типа слияния, в рассылке). если нет, может натолкнете куда копать?
 
 
 
#2
03.11.2020 13:46:14
чисто гипотетически для слияния нужно трасформировать таблицу с данными в подобие кросс таблицы, где строка каждая это адрес не включая квартиру, а правее идут чередуясь квартира, долг, квартира, долг, тогда можно слиянием кропотливо занести все эти поля в таблицу, но размер таблички будет не очень красивым.
Проще подготовить шаблон в Excel, который соберет по дому подборку квартир с долгами. Макросом можно автоматезировать печать.

P.S. В Access это делается стандартным отчетом.
Изменено: БМВ - 03.11.2020 13:49:56
По вопросам из тем форума, личку не читаю.
 
 
 
#3
03.11.2020 17:03:16
Макросы писать не умею, поэтому сделала бы как-то так (да простят меня профессионалы):
1). Создала бы табличку в колонках K, L, M (ячейки K2 и K3 различаются, нужно вставить обе ячейку, а потом K3 протянуть вниз, L и M просто скопировать и протянуть вниз).
2). Отсортировать не важно K, L или M, убрав пустые ячейки. Скопировать получившуюся табличку из 3 столбцов и сколько там у Вас будет строк
3). На отдельный лист вставить эту табличку "Специальной вставкой", нажав галочки "Только значения" и "Транспонировать" (у меня это Лист2)
4). Создать ещё один лист и скопировать в него то, что у меня расположено на Листе1. Выделить область D1:E41 и тянуть пока не перечисляться все дома. Потом вставить ширину ячеек и протянуть область печати. Ещё я на этом листе сделала условное форматирование в строках с 12 по 41 - так, чтобы была рамочка в непустых ячейках..
"Просите, и дано будет вам; ищите, и найдете; стучите, и отворят вам" (Мф. 7. 7-9)
 
 
 
#4
03.11.2020 23:10:29
Ligub, вариант см. файл
Код
Sub dsd()
Dim col As New Collection, i As Long, lr As Long, shablon As Worksheet, sh As Worksheet, arr, n As Long
Set sh = Worksheets("Page 1"): Set shablon = Worksheets("ШАБЛОН")
lr = sh.Cells(Rows.Count, 2).End(xlUp).Row
ReDim arr(0, 0)
For i = 2 To lr
    On Error Resume Next
    x = "дома №" & sh.Cells(i, 5) & " по ул. " & sh.Cells(i, 4)
    col.Add x, CStr(x)
Next i
For i = 1 To col.Count
    shablon.Cells(4, 1) = col(i)
    k = 6
    shablon.Range("B6:G200").Clear
    For n = 2 To lr
    dom = CLng(Mid(col(i), InStr(col(i), "№") + 1, (InStr(col(i), "ул.") - 4) - (InStr(col(i), "№") + 1)))
    ul = Mid(col(i), (InStr(col(i), "ул.") + 4), Len(col(i)) - (InStr(col(i), "ул.") + 3))
        If dom = sh.Cells(n, 5) And ul = sh.Cells(n, 4) And sh.Cells(n, 9) > 0 Then
        shablon.Cells(k, 2) = sh.Cells(n, 7)
        shablon.Range(shablon.Cells(k, 2), shablon.Cells(k, 4)).Merge
        shablon.Cells(k, 5) = sh.Cells(n, 9)
        shablon.Range(shablon.Cells(k, 5), shablon.Cells(k, 7)).Merge
        k = k + 1
        End If
    Next n
        With Range("B6:G" & shablon.Cells(Rows.Count, 2).End(xlUp).Row).Borders
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    shablon.PrintOut Copies:=1, Collate:=True
Next i
End Sub
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#5
04.11.2020 10:03:30
Mershik, очень классный вариант, спасибо!!

слушай, а можно же допилить момент, если много квартир в списке, то что бы печатало несколько экземпляров ( например, если квартир больше 3, значить напечатается 2 копии, если квартир больше 8 - 3 копии, больше 17 кв. - 4 копии) ?
 
 
 
#6
04.11.2020 10:13:40
Ligub, у меня нет принтера не знаю работает или нет
Код
Sub dsd()
Dim col As New Collection, i As Long, lr As Long, shablon As Worksheet, sh As Worksheet, arr, n As Long
Set sh = Worksheets("Page 1"): Set shablon = Worksheets("ØÀÁËÎÍ")
lr = sh.Cells(Rows.Count, 2).End(xlUp).Row
ReDim arr(0, 0)
For i = 2 To lr
    On Error Resume Next
    x = "äîìà ¹" & sh.Cells(i, 5) & " ïî óë. " & sh.Cells(i, 4)
    col.Add x, CStr(x)
Next i
For i = 1 To col.Count
    shablon.Cells(4, 1) = col(i)
    k = 6
    shablon.Range("B6:G200").Clear
    For n = 2 To lr
    dom = CLng(Mid(col(i), InStr(col(i), "¹") + 1, (InStr(col(i), "óë.") - 4) - (InStr(col(i), "¹") + 1)))
    ul = Mid(col(i), (InStr(col(i), "óë.") + 4), Len(col(i)) - (InStr(col(i), "óë.") + 3))
        If dom = sh.Cells(n, 5) And ul = sh.Cells(n, 4) And sh.Cells(n, 9) > 0 Then
        shablon.Cells(k, 2) = sh.Cells(n, 7)
        shablon.Range(shablon.Cells(k, 2), shablon.Cells(k, 4)).Merge
        shablon.Cells(k, 5) = sh.Cells(n, 9)
        shablon.Range(shablon.Cells(k, 5), shablon.Cells(k, 7)).Merge
        k = k + 1
        End If
    Next n
        With Range("B6:G" & shablon.Cells(Rows.Count, 2).End(xlUp).Row).Borders
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Z = Application.WorksheetFunction.CountA(shablon.Columns(3))
    If Z <= 8 Then
        cop = 2
    ElseIf Z <= 17 Then
        cop = 3
    Else
        cop = 4
    End If
    shablon.PrintOut Copies:=cop, Collate:=True
Next i
End Sub
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#7
04.11.2020 10:19:52
Mershik, установи doPdf, или что-то аналогичное. Иногда бывает очень полезно.
 
 
 
#8
04.11.2020 10:21:38
RAN, спасибо. ну у меня есть - автоматически сохраняет в pdf -просто количество копий видимо не сохраняет или я не умею
Изменено: Mershik - 04.11.2020 10:21:50
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#9
04.11.2020 10:53:15
Количество копий, это просто. Сидишь, и считаешь, сколько раз doPdf запустится.  :D
 
 
 
#10
04.11.2020 11:08:26
пока дела поделал, сам решил перечитать код и понял как сделать), захожу на форум, а тут уже есть ответ :) спасибо еще раз
 
 
 
Страницы: 1
Наверх