Tropin
Full Member | Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору 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 |
---------- Вот потому, что вы говорите то, что не думаете и думаете то, что не думаете, вот в клетках и сидите... (C) Кин-дза-дза |
|