Здравствуйте!
В продолжение темы.
При копировании из ОБД списка на N человек (списки возможны и были у меня в работе на сотни человек) и дальнейшей его обработки в Exsel получается такая, к примеру, картина:
1 Донесение о потерях
Тюрин Юрий Григорьевич
__.__.1923
30.07.1943
Пензенская обл., II Пенза, ул. Баумана, д. 91
2 Донесение о потерях
Кривулин Парфирий Иванович
__.__.1903
19.07.1943
Пензенская обл., ст. Пенза
3 Донесение о потерях
Шурыгин Николай Осипович
__.__.1923
19.07.1943
г. Пенза, с/з "Железнодорожный", 14, участок № 2
4 Донесение о потерях
Соколов Сергей Егорович
__.__.1920
28.08.1943
г. Пенза
5 Донесение о потерях
Медьков Сергей Алексеевич
__.__.1922
20.07.1943
г. Пенза
Для формирования таблицы в Exsel нужно информацию на одного человека расположить в одну строку, причем каждый вид информации в свой столбец. Причем, при копировании списка из ОБД непосредственно в Exsel копируются условные значки, обозначающие определенный вид донесений, в виде графических символов, которые не просто убрать с листа Exsel. Для исключения этого приходится делать промежуточную запись списка в текстовый редактор.
В Exsel есть стандартная функция преобразования из столбца в строку, но это надо делать для записи на каждого человека отдельно. При этом разноса информации по своим столбцам не получится.
Мной создана программа (макрос) для транспонирования списка ОБД любой длины. Макрос автоматически преобразует список ОБД в файл Exsel, информация (дата рождения, дата выбытия и т.д. ) разнесена по своим столбцам, в завершение список отсортирован по алфавиту.
Вот пример, список пензенцев (список ограничен 25-ю, всего в списке 157 имен), павших в Снежнянском р-не Сталинской области (сейчас Шахтёрский р-н ДонецкойНародной Республики).
Аверин Павел Петрович __.__.1922 23.07.1943 Пензенская обл., Салтыковский р-н
Артаков Владимир Иванович __.__.1913 22.07.1943 Пензенская обл., г. Пенза
Безверхов Николай Дмитриевич 29.07.1943 Пензенская обл., Терновский р-н, Дурасовский с/с, дер. П. Краснополье
Будаков Сергей Андреевич __.__.1899 18.07.1943 Пензенская обл.
Жиделев Алексей Савельевич __.__.1912 20.07.1943 Пензенская обл., Тамалинский р-н, с. Шуякино
Каменев Илья Андреевич __.__.1924 19.07.1943 Пензенская обл., Наровчатский р-н, с. Большой Чердак
Кирин Иван Кириллович __.__.1901 25.07.1943 Пензенская обл., Башмаковский р-н
Климкин Федор Васильевич __.__.1920 19.07.1943 Пензенская обл., Свищевский р-н
Клинов Михаил Иванович __.__.1924 26.07.1943 Пензенская обл., г. Нижне-Ломовск
Кривулин Парфирий Иванович __.__.1903 19.07.1943 Пензенская обл., ст. Пенза
Кузнецов Леонид Иосифович __.__.1920 21.07.1943 Пензенская обл., Городищенский р-н
Кулясов Иван Степанович 20.07.1943 Пензенская обл., Иссинский р-н, Владыкинский с/с
Медьков Сергей Алексеевич __.__.1922 20.07.1943 г. Пенза
Морозов Никифор Никифорович __.__.1911 18.07.1943 г. Пенза
Николаев Николай Сергеевич __.__.1920 01.08.1943 Пензенская обл., Кондольский р-н, с. Ивановка
Основин Александр Михайлович __.__.1908 20.07.1943 Пензенская обл., Ватницкий р-н
Панищев Гаврил Александрович __.__.1902 25.07.1943 Пензенская обл., Пачелмский р-н, с. Ворона
Прокофьев Анатолий Николаевич __.__.1913 21.07.1943 Пензенская обл., Даниловский р-н, с. Чунаки
Соколов Сергей Егорович __.__.1920 28.08.1943 г. Пенза
Тюрин Юрий Григорьевич __.__.1923 30.07.1943 Пензенская обл., II Пенза, ул. Баумана, д. 91
Фомин Григорий Васильевич 19.07.1943 Пензенская обл., Мокшанский р-н, с. Фатуевка
Червяков Василий Дмитриевич __.__.1924 24.07.1943 Пензенская обл., Свищевский р-н, Лягушевский с/с, дер. Лягушевка
Шалянов Сергей Иванович 31.07.1943 Пензенская обл., Бессоновский р-н, с. Б.-Каллера
Шкарин Александр Петрович __.__.1912 30.07.1943 Пензенская обл., Камашкирский р-н, с. Порзово
Шурыгин Николай Осипович __.__.1923 19.07.1943 г. Пенза, с/з "Железнодорожный", 14, участок № 2
Макрос для транспонирования списка ОБД:
Sub ТРАНСП_СПИСКА()
'
' ТРАНСП_СПИСКА Макрос Транспонирует записи списка ОБД построчно,
' сортирует
'
Dim n As Integer, i As Integer, a1 As Integer
Dim mStr1 As String, mStr2 As String, mStr3 As String, mStr4 As String, mStr5 As String, mStr6 As String
Range("A1").Select
n = InputBox("Введите n")
ActiveCell.Range("A1").Select
Selection.Copy
a1 = Cells(Rows.Count, 1).End(xlUp).Row
ActiveCell.Offset(a1, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(-a1, 0).Range("A1:A5").Select
Application.CutCopyMode = False
For i = 1 To n
Range("A1").Select
mStr3 = Cells(3, 1)
mStr6 = Cells(6, 1)
ActiveCell.Range("A1:A5").Select
If InStr(mStr6, "Донесение") Or InStr(mStr6, "Документ") Then GoTo M1
If Mid(mStr3, 9, 1) = "4" Then
'вставка строки 3
ActiveCell.Rows("3:3").EntireRow.Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Offset(-2, 0).Range("A1:A5").Select
GoTo M2
End If
M4: mStr4 = Cells(4, 1)
If Mid(mStr4, 9, 1) <> "4" Then
'вставка строки 4
ActiveCell.Rows("4:4").EntireRow.Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Offset(-3, 0).Range("A1:A5").Select
M2: End If
mStr5 = Cells(5, 1)
If InStr(mStr5, "Донесение") Or InStr(mStr5, "Документ") Then
'вставка строки 5
ActiveCell.Rows("5:5").EntireRow.Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Offset(-4, 0).Range("A1:A5").Select
End If
'Выполнение транспонирования,
M1: ActiveCell.Range("A1:A5").Select
Selection.Copy
a1 = Cells(Rows.Count, 1).End(xlUp).Row
ActiveCell.Offset(a1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
'Вставляем строку перед результатом
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Offset(1, 0).Range("A1").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
ActiveCell.Offset(-a1 - 1, 0).Range("A1:A5").Select
ActiveCell.Range("A1:E5").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Next i
Rows("1:2").Select
Selection.Delete Shift:=xlUp
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Columns("A:A").Select
ActiveWorkbook.Worksheets("Лист3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Лист3").Sort.SortFields.Add Key:=Range("A1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Лист3").Sort
.SetRange Range("A1:D150")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1").Select
'
End Sub
Примечание. Обрабатываемый список нужно размещать на Листе 3 книги Exsel в ячейку А1. По запросу "Введите n" надо ввести число n имен в списке.