Компьютерный форум OSzone.net  

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)
-   Microsoft Office (Word, Excel, Outlook и т.д.) (http://forum.oszone.net/forumdisplay.php?f=115)
-   -   [решено] Объединание строк в Microsoft Office (http://forum.oszone.net/showthread.php?t=295924)

phoenix91140 23-02-2015 10:30 2474771
Объединание строк в Microsoft Office
 
Вложений: 1
Добрый день!

Нужна помощь с Microsoft Office. Есть некая таблица, где есть колонки: имя, фамилия, мероприятие 1, мероприятие 2, мероприятие 3 и тд. И дальше идёт заполнение по строкам, где имя и фамилия и значение "Да", если человек был на мероприятии. Проблема в том, что нужна функция, которая копировала бы таблицу объединяя данные по дубликатам(критерием являются имя и фамилия). Помогите пожалуйста! Заранее спасибо. Файл с примером задачи прилагается.

okshef 23-02-2015 11:14 2474787
phoenix91140, уточните, как объединяются мероприятия, что в результате? Т.к. для удаления повторяющихся имен и фамилий есть встроенная функция "Удалить дубликаты". Но в этом случае о данных в колонках "Мероприятие..." можно забыть

phoenix91140 23-02-2015 12:58 2474834
Вложений: 1
Нужно получить в итоге Имя и Фамилию, и чтобы значения мероприятий перешли все в одну строку.

Прилагаю новый файл. В таблице слева, то как это есть до изменений, а справа, то что должно получиться. Как вот такое на автомате сделать?

Тоесть чтобы строки с повторябшимся именем и фамилией объединялись в одну и значения мероприятий со всех строк сложились в одну строку. Данные мероприятий указанные в разных строках надо сохранить в одну строку и оставить лишь одну строку на уникального человека(имя + фамилия).

Вот новый файл

Iska 23-02-2015 15:29 2474899
Процедура на VBA:
Скрытый текст
Код:
Sub Sample()
    Dim objConnection As Object
    Dim objRecordSet As Object
   
    Dim objWorksheet As Worksheet
    Dim objRange As Range
   
    Dim i As Integer
   
   
    Set objConnection = CreateObject("ADODB.Connection")
   
    With objConnection
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = _
            "Data Source=" & ThisWorkbook.FullName & ";" & _
            "Extended Properties=""Excel 8.0;HDR=Yes;"""
        .Open
    End With
   
    Set objRecordSet = objConnection.Execute( _
            "SELECT FIRST(Имя) AS Имя, FIRST(Фамилия) AS Фамилия, " & _
            "COUNT([Мероприятие 1]) AS [Мероприятие 1], " & _
            "COUNT([Мероприятие2])  AS [Мероприятие 2], " & _
            "COUNT([Мероприятие 3]) AS [Мероприятие 3], " & _
            "COUNT([Мероприятие 4]) AS [Мероприятие 4] " & _
            "FROM [Sheet1$] " & _
            "GROUP BY Имя, Фамилия ORDER BY Фамилия, Имя" _
        )
   
    Set objWorksheet = ThisWorkbook.Worksheets.Add()
    Set objRange = objWorksheet.Range("A1")
   
    With objRecordSet
        .MoveFirst
       
        For i = 0 To .Fields.Count - 1
            objRange.Offset(0, i).Value = .Fields.Item(i).Name
        Next
       
        Do Until .EOF
            Set objRange = objRange.Offset(1, 0)
           
            For i = 0 To 1
                objRange.Offset(0, i).Value = .Fields.Item(i).Value
            Next
           
            For i = 2 To .Fields.Count - 1
                If .Fields.Item(i).Value Then
                    objRange.Offset(0, i).Value = "Да"
                End If
            Next
           
            .MoveNext
        Loop
    End With
   
    objWorksheet.Columns("A:F").AutoFit
   
    Set objRange = Nothing
    Set objWorksheet = Nothing
   
    objRecordSet.Close
    objConnection.Close
   
    Set objRecordSet = Nothing
    Set objConnection = Nothing
End Sub

Рабочая книга перед исполнением процедуры должна быть сохранена. Проверялось под Office 2003:
Скрытый текст

Заработает ли у Вас — не скажу.

Пример на коленке делали? «Эдгар/Эдраг», «Мероприятие 1/Мероприятие2».


Время: 01:06.

Время: 01:06.
© OSzone.net 2001-