-Поиск по дневнику

Поиск сообщений в rss_sql_ru_access_programming

 -Подписка по e-mail

 

 -Постоянные читатели

 -Статистика

Статистика LiveInternet.ru: показано количество хитов и посетителей
Создан: 16.03.2006
Записей:
Комментариев:
Написано: 4


Объединить ячейки при повторе данных

Вторник, 10 Июня 2014 г. 10:06 + в цитатник
Доброго времени суток..
Есть у меня такой код для выгрузки в Excel
Все выгружается вот таким образом (см.рис)
+
Private Function Oplaty()
Dim XL As Object, XLBook As Object, XLSheet As Object
    Dim ClientDir As String, TmplFile As String, OutputDir As String, OutputFile As String, Pos As Long, df As String
    Dim rst As Object, SubRst As Object, StrN As Long
    Dim opl As String
    Dim LogN As Integer, VzakN As Integer, Nach As Integer
 
'    Set rst = CurrentDb.OpenRecordset("SELECT * FROM ОплатыДаты ORDER BY Номер", dbOpenDynaset, dbSeeChanges)
 
Set rst = CurrentDb.OpenRecordset("SELECT Заказ.Номер, Заказ.Поставщик, Заказ.НомерВэд, Оплата.Сумма, Оплата.Подписан, " _
& " Оплата.Получены, [Итоговая сумма заказа].сумм, [Сумма]/[сумм] AS Проценты" _
& " FROM (Заказ INNER JOIN Оплата ON Заказ.Номер = Оплата.Заказ)" _
& " INNER JOIN [Итоговая сумма заказа] ON Заказ.Номер = [Итоговая сумма заказа].Номер", dbOpenDynaset, dbSeeChanges)
 
    TmplFile = "\\server.a\Data\Отдел\! ABS\Шаблоны\Оплаты.xlsx"
 
    sPatchtDir = Environ("ALLUSERSPROFILE") & "\Оплаты"
        If Dir$(sPatchtDir, vbDirectory) = "" Then
        MkDir sPatchtDir
    End If
 
    OutputFile = sPatchtDir & "\Оплаты.xlsx"
    FileCopy TmplFile, OutputFile
           ''Создать объекты Excel
           
'On Error GoTo OLEError
    Set XL = CreateObject("Excel.Application")
 
'On Error GoTo AnyError
    Set XLBook = XL.Workbooks.Open(OutputFile)
 
           ''Вывод в конкретный шаблон
 
           ''1-й лист Заполняем шапку
        Set XLSheet = XLBook.Worksheets(1)
        XLSheet.Activate
        XLSheet.Cells(1, 1).value = "Название компании"
        XLSheet.Cells(1, 2).value = "Контактное лицо"
        XLSheet.Cells(1, 3).value = "№ заказа"
        XLSheet.Cells(1, 4).value = "Инвойс по проекту"
        XLSheet.Cells(1, 5).value = "Сумма инвойса"
        XLSheet.Cells(1, 6).value = "Сумма к оплате"
        XLSheet.Cells(1, 7).value = "процентная часть"
        XLSheet.Cells(1, 8).value = "Дата подачи счета менедрером ОМЗ"
        XLSheet.Cells(1, 9).value = "Дата подтверждения инвойса Стройковым М.М."
        XLSheet.Cells(1, 10).value = "Дата передачи подтвержденного инвойса в отдел ВЭД"
        XLSheet.Cells(1, 11).value = "Дата оплаты"
        XLSheet.Cells(1, 12).value = "Дата получение оплаты"
 
           ''Выгрузка заказов
 
        StrN = 2
        Do While Not rst.EOF
'        XLSheet.Cells(StrN, 1) = rst![ЮридическоеНазвание]
        XLSheet.Cells(StrN, 2) = rst![Поставщик]
        XLSheet.Cells(StrN, 3) = rst![НомерВЭД]
        XLSheet.Cells(StrN, 4) = rst![Подпроект]
        XLSheet.Cells(StrN, 5) = rst![сумм]
        XLSheet.Cells(StrN, 6) = rst![Сумма]
        XLSheet.Cells(StrN, 7) = rst![Проценты]
        XLSheet.Cells(StrN, 8) = rst![СчетПодан]
        XLSheet.Cells(StrN, 9) = rst![Подписан]
        XLSheet.Cells(StrN, 10) = rst![ДатаПередачиВЭД]
        XLSheet.Cells(StrN, 11) = rst![ДатаПП]
        XLSheet.Cells(StrN, 12) = rst![Получены]
        Postavshik = rst![Поставщик]
            rst.MoveNext
            StrN = StrN + 1
        Loop
    
    XLBook.Save
    XLBook.Application.ActiveWorkbook.RefreshAll
    XL.Visible = True
    Oplaty = True
    Exit Function
 
'OLEError:
'    MsgBox "Microsoft Excel - не установлен.", , "Ошибка вывода формы " & TmplName
'    Oplaty = False
'    Exit Function
'
'AnyError:
'    MsgBox "Неопознанная ошибка.", , "Ошибка вывода формы " & TmplName
'    Oplaty = False
'    Exit Function
End Function


Подскажите, как можно объединить ячейки с повторяющимися данными
т.е чего бы в итоге получить хотелось бы, если в столбце в ячейках идет повторение, тогда объединить эти ячейки если пустая ячейка тогда просто пропустить её

http://www.sql.ru/forum/1099469/obedinit-yacheyki-pri-povtore-dannyh


 

Добавить комментарий:
Текст комментария: смайлики

Проверка орфографии: (найти ошибки)

Прикрепить картинку:

 Переводить URL в ссылку
 Подписаться на комментарии
 Подписать картинку