Философия

Информация о пользователе

Привет, Гость! Войдите или зарегистрируйтесь.

Вы здесь » Философия » Задачи по Excel » Автоматическое увеличение строк в таблице

Автоматическое увеличение строк в таблице

Страница: 1

Сообщений 1 страница 5 из 5

1

  • Автор: Ничипорчук Максим
  • Активный участник
  • Зарегистрирован: 2010-11-29
  • Приглашений: 0
  • Сообщений: 51
  • Уважение: [+0/-0]
  • Позитив: [+0/-0]
  • Провел на форуме:
    1 день 19 часов
  • Последний визит:
    2011-03-18 14:36:21

Автоматическое увеличение строк в таблице при занесении данных на другой лист excel.
На Лист1 есть таблица (например, заполнено 10 строк, ячейки А1-А10). Таблица обведена жирной рамкой.
На Лист2  занесены данные, которые и отображены в таблице на Лист1. Требуется, чтобы при занесении записи на Лист2, в таблице на Лист1 добавлялась строка, в нее заносилась соответствующая запись из Лист2 и чтобы новая строка была оформлена так же, как и таблица (т.е. с жирной рамкой) .

0

2

  • Автор: Ничипорчук Максим
  • Активный участник
  • Зарегистрирован: 2010-11-29
  • Приглашений: 0
  • Сообщений: 51
  • Уважение: [+0/-0]
  • Позитив: [+0/-0]
  • Провел на форуме:
    1 день 19 часов
  • Последний визит:
    2011-03-18 14:36:21

Решение. Версия 1.
Синхронизация данных основана на простых формульных ссылках. Рамка таблицы перерисовывается по событию изменения содержимого ячеек.

Код события изменения ячеек на листе 2:

Код:
Private Sub Worksheet_Change(ByVal Target As Range)
   If Not Intersect(Range("A1:A40"), Target) Is Nothing Then
            Dim RowNum As String
            Dim rng, Crng As Range


    ' Находим номер последней непустой ячейки в столбце
    For Each cell In Worksheets("Лист1").Range("A1:A50")
        If IsEmpty(cell.Value) Or cell = " " Then
           RowNum = cell.Row - 1
           Exit For
        End If
    Next
    
    Set Crng = Worksheets("Лист1").Range("A1:A99")
    
    'Выделяем непустые ячейки в столбце А
    Set rng = Worksheets("Лист1").Range("A1:A" + RowNum)
        
    'Убираем все старые рамки
    Crng.Borders(xlDiagonalDown).LineStyle = xlNone
    Crng.Borders(xlDiagonalUp).LineStyle = xlNone
    Crng.Borders(xlEdgeLeft).LineStyle = xlNone
    Crng.Borders(xlEdgeTop).LineStyle = xlNone
    Crng.Borders(xlEdgeBottom).LineStyle = xlNone
    Crng.Borders(xlEdgeRight).LineStyle = xlNone
    Crng.Borders(xlInsideVertical).LineStyle = xlNone
    Crng.Borders(xlInsideHorizontal).LineStyle = xlNone
    
    'Обводим жирной рамкой
    With rng.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With rng.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With rng.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With rng.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
   End If

End Sub

Формула ячейки на Листе 1:

Код:
=ЕСЛИ(ЕПУСТО(Лист2!$A1);" ";Лист2!$A1)

http://depositfiles.com/files/22vctubus

0

3

  • Автор: Сергей
  • Активный участник
  • Зарегистрирован: 2010-11-30
  • Приглашений: 0
  • Сообщений: 97
  • Уважение: [+1/-0]
  • Позитив: [+0/-0]
  • Провел на форуме:
    1 день 6 часов
  • Последний визит:
    2011-03-18 23:26:07

Максим, да, это то, что я имел в виду. Логику понял, но просьба (чувствую, что без Вас долго буду переделывать),
сделать для случая двух столбцов (н-р, страна - столица или что угодно), причем у таблицы есть и все внутренние рамки, а не только внешняя - т.е. все ячейки тоже обведены жирной рамкой.

0

4

  • Автор: Ничипорчук Максим
  • Активный участник
  • Зарегистрирован: 2010-11-29
  • Приглашений: 0
  • Сообщений: 51
  • Уважение: [+0/-0]
  • Позитив: [+0/-0]
  • Провел на форуме:
    1 день 19 часов
  • Последний визит:
    2011-03-18 14:36:21

Вот.

Код:
Private Sub Worksheet_Change(ByVal Target As Range)
   If Not Intersect(Range("A1:B40"), Target) Is Nothing Then
            Dim RowNum As String
            Dim rng, Crng As Range


    ' Находим номер последней непустой ячейки в столбце
    For Each cell In Worksheets("Лист1").Range("A1:A50")
        If (IsEmpty(cell.Value) Or cell = " ") And (IsEmpty(Cells(cell.Row, cell.Column + 1).Value) Or Cells(cell.Row, cell.Column + 1) = " ") Then
        
            
           RowNum = cell.Row - 1
           Exit For
        End If
    Next
    
    Set Crng = Worksheets("Лист1").Range("A1:B99")
    
    'Выделяем непустые ячейки в столбце А
    Set rng = Worksheets("Лист1").Range("A1:B" + RowNum)
        
    'Убираем все старые рамки
    Crng.Borders(xlDiagonalDown).LineStyle = xlNone
    Crng.Borders(xlDiagonalUp).LineStyle = xlNone
    Crng.Borders(xlEdgeLeft).LineStyle = xlNone
    Crng.Borders(xlEdgeTop).LineStyle = xlNone
    Crng.Borders(xlEdgeBottom).LineStyle = xlNone
    Crng.Borders(xlEdgeRight).LineStyle = xlNone
    Crng.Borders(xlInsideVertical).LineStyle = xlNone
    Crng.Borders(xlInsideHorizontal).LineStyle = xlNone
    
    'Обводим жирной рамкой
    With rng.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With rng.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With rng.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With rng.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With rng.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With rng.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
   End If

End Sub

http://depositfiles.com/files/wo5mppw25

0

5

  • Автор: Сергей
  • Активный участник
  • Зарегистрирован: 2010-11-30
  • Приглашений: 0
  • Сообщений: 97
  • Уважение: [+1/-0]
  • Позитив: [+0/-0]
  • Провел на форуме:
    1 день 6 часов
  • Последний визит:
    2011-03-18 23:26:07

Максим, отлично,

работает в 2003 и 2007. Отдельное спасибо за доделку.

Задача решена.

0

Страница: 1

Вы здесь » Философия » Задачи по Excel » Автоматическое увеличение строк в таблице