NecroHill ответ на пост
http://forum.ru-board.com/topic.cgi?forum=5&bm=1&topic=4495&start=740#9 Давай мыло, вышлю экселевский файл с этим макросом
Код: Sub table()
' Определимся с Листами
Set WS1 = Worksheets("Лист1")
Set WS2 = Worksheets("Лист2")
' Первая и последняя строчки в первой таблице
StartRow1 = 1
EndRow1 = 9
' Первый и последний столбец с данными первой таблицы
FirstCol1 = 4
LastCol1 = 6
' Первая и последняя строчки во второй таблице
StartRow2 = 11
EndRow2 = 19
' Первый и последний столбец с данными второй таблицы
FirstCol2 = 4
LastCol2 = 6
'--------------
Dim ColNum1(), ColNum2() As Integer
Dim ColNumSize1, ColNumSize2 As Integer
' номер последнего текущего столбца в третьей таблице
CLastCol = 1
ReDim ColNum1(LastCol1)
ReDim ColNum2(LastCol2)
' 0. Очищаем лист2
WS2.Cells.ClearContents
WS2.Cells(1, 1) = "CLOCK#"
' 1. Добавляем необходимые столбцы в третью таблицу
' Цикл по столбцам первой таблицы
For j = FirstCol1 To LastCol1
stroka = WS1.Cells(StartRow1, j)
Set C = WS2.Rows(1).Find(stroka, LookIn:=xlValues, LookAt:=xlWhole)
' Если столбец с таким номером не существует, то добавляем его
If C Is Nothing Then
CLastCol = CLastCol + 1
WS2.Cells(1, CLastCol) = stroka
ColNum1(j) = CLastCol
Else
ColNum1(j) = C.Column
End If
Next j
' Цикл по столбцам второй таблицы
For j = FirstCol2 To LastCol2
stroka = WS1.Cells(StartRow2, j)
Set C = WS2.Rows(1).Find(stroka, LookIn:=xlValues, LookAt:=xlWhole)
' Если столбец с таким номером не существует, то добавляем его
If C Is Nothing Then
CLastCol = CLastCol + 1
WS2.Cells(1, CLastCol) = stroka
ColNum2(j) = CLastCol
Else
ColNum2(j) = C.Column
End If
Next j
CLastRow = 1
' 2. Добавляем строчки в третью таблицу
' Цикл по строчкам первой таблицы
For i = StartRow1 + 1 To EndRow1
stroka = WS1.Cells(i, 2)
Set C = WS2.Columns(1).Find(stroka, LookIn:=xlValues, LookAt:=xlWhole)
' Если строки с таким номером еще нет, то создаем ее
If C Is Nothing Then
CLastRow = CLastRow + 1
WS2.Cells(CLastRow, 1) = stroka
CR = CLastRow
Else
CR = C.Row
End If
' CR - номер текущей строки
For j = FirstCol1 To LastCol1
WS2.Cells(CR, ColNum1(j)) = WS2.Cells(CR, ColNum1(j)) + WS1.Cells(i, j)
Next j
Next i
' Цикл по строчкам второй таблицы
For i = StartRow2 + 1 To EndRow2
stroka = WS1.Cells(i, 2)
Set C = WS2.Columns(1).Find(stroka, LookIn:=xlValues, LookAt:=xlWhole)
' Если строки с таким номером еще нет, то создаем ее
If C Is Nothing Then
CLastRow = CLastRow + 1
WS2.Cells(CLastRow, 1) = stroka
CR = CLastRow
Else
CR = C.Row
End If
' CR - номер текущей строки
For j = FirstCol2 To LastCol2
WS2.Cells(CR, ColNum2(j)) = WS2.Cells(CR, ColNum2(j)) + WS1.Cells(i, j)
Next j
Next i
End Sub
.. что-то же в настройках должно быть..имхо..