Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/автоматическое добавление строки - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по Excel » автоматическое добавление строки (Формулы/Formulas)
автоматическое добавление строки
Sedoy Дата: Воскресенье, 27.03.2016, 00:37 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Всем привет!
Требуется автоматически добавлять строку с ФИО в листе блок1 или блок2 в зависимости от того, какой статус имеет ФИО во вкладке База данных. Т.е. в зависимости от того, какой статус мы пишем в Базе данных, в одной из вкладок: блок1 или блок2 должны автоматически появиться ФИО
К сообщению приложен файл: prob.xls(32Kb)
 
Ответить
СообщениеВсем привет!
Требуется автоматически добавлять строку с ФИО в листе блок1 или блок2 в зависимости от того, какой статус имеет ФИО во вкладке База данных. Т.е. в зависимости от того, какой статус мы пишем в Базе данных, в одной из вкладок: блок1 или блок2 должны автоматически появиться ФИО

Автор - Sedoy
Дата добавления - 27.03.2016 в 00:37
StoTisteg Дата: Воскресенье, 27.03.2016, 00:51 | Сообщение № 2
Группа: Авторы
Ранг: Ветеран
Сообщений: 541
Репутация: 45 ±
Замечаний: 0% ±

Excel 2010
Я бы стал макросом делать. Наверно, и формулами можно, но будет, кмк, мозголомно...


Проверь всё. ThisWorkbook.Save. On Error Resume Next.

Сообщение отредактировал StoTisteg - Воскресенье, 27.03.2016, 01:45
 
Ответить
СообщениеЯ бы стал макросом делать. Наверно, и формулами можно, но будет, кмк, мозголомно...

Автор - StoTisteg
Дата добавления - 27.03.2016 в 00:51
Wasilich Дата: Воскресенье, 27.03.2016, 01:22 | Сообщение № 3
Группа: Друзья
Ранг: Ветеран
Сообщений: 872
Репутация: 221 ±
Замечаний: 0% ±

2003
Ну если макросом то наверное так
[vba]
Код
Sub перенос()
  Dim r1&, r2&, i&
  r1 = Sheets("блок1").Range("B" & Rows.Count).End(xlUp).Row + 1
  r2 = Sheets("блок2").Range("B" & Rows.Count).End(xlUp).Row + 1
  For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
    If Cells(i, 3) = "блок1" Then
      Sheets("блок1").Cells(r1, 2) = Cells(i, 2)
      r1 = r1 + 1
    End If
    If Cells(i, 3) = "блок2" Then
      Sheets("блок2").Cells(r2, 2) = Cells(i, 2)
      r2 = r2 + 1
    End If
  Next
End Sub
[/vba]
К сообщению приложен файл: Sedoy.xls(50Kb)
 
Ответить
СообщениеНу если макросом то наверное так
[vba]
Код
Sub перенос()
  Dim r1&, r2&, i&
  r1 = Sheets("блок1").Range("B" & Rows.Count).End(xlUp).Row + 1
  r2 = Sheets("блок2").Range("B" & Rows.Count).End(xlUp).Row + 1
  For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
    If Cells(i, 3) = "блок1" Then
      Sheets("блок1").Cells(r1, 2) = Cells(i, 2)
      r1 = r1 + 1
    End If
    If Cells(i, 3) = "блок2" Then
      Sheets("блок2").Cells(r2, 2) = Cells(i, 2)
      r2 = r2 + 1
    End If
  Next
End Sub
[/vba]

Автор - Wasilich
Дата добавления - 27.03.2016 в 01:22
StoTisteg Дата: Воскресенье, 27.03.2016, 01:43 | Сообщение № 4
Группа: Авторы
Ранг: Ветеран
Сообщений: 541
Репутация: 45 ±
Замечаний: 0% ±

Excel 2010
У меня получилось вот что, через событие листа База данных:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Column < 4 And Cells(Target.Row, 1).Value <> "" And Cells(Target.Row, 2).Value <> "" And Cells(Target.Row, 3).Value <> "" Then
        If Cells(Target.Row + 1, Target.Column).Value = "" Then
            With Worksheets(Cells(Target.Row, 3).Value)
                .Cells(.Cells(Rows.Count, 2).End(xlUp).Row + 1, 1).Value = Val(.Cells(.Cells(Rows.Count, 2).End(xlUp).Row, 1).Value) + 1
                .Cells(.Cells(Rows.Count, 2).End(xlUp).Row + 1, 2).Value = Cells(Target.Row, 2).Value
            End With
        End If
    End If

End Sub
[/vba]
но это явно сыро...
К сообщению приложен файл: Raznos.xlsm(22Kb)


Проверь всё. ThisWorkbook.Save. On Error Resume Next.
 
Ответить
СообщениеУ меня получилось вот что, через событие листа База данных:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Column < 4 And Cells(Target.Row, 1).Value <> "" And Cells(Target.Row, 2).Value <> "" And Cells(Target.Row, 3).Value <> "" Then
        If Cells(Target.Row + 1, Target.Column).Value = "" Then
            With Worksheets(Cells(Target.Row, 3).Value)
                .Cells(.Cells(Rows.Count, 2).End(xlUp).Row + 1, 1).Value = Val(.Cells(.Cells(Rows.Count, 2).End(xlUp).Row, 1).Value) + 1
                .Cells(.Cells(Rows.Count, 2).End(xlUp).Row + 1, 2).Value = Cells(Target.Row, 2).Value
            End With
        End If
    End If

End Sub
[/vba]
но это явно сыро...

Автор - StoTisteg
Дата добавления - 27.03.2016 в 01:43
Nic70y Дата: Воскресенье, 27.03.2016, 08:58 | Сообщение № 5
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3483
Репутация: 722 ±
Замечаний: 0% ±

Excel 2013
мозголомно
если с доп.столбцом, то не так уж мозголомно
К сообщению приложен файл: 6085451.xls(41Kb)


ЯД(poison) 41001841029809
+7 978 049 98 74 (мтс)
 
Ответить
Сообщение
мозголомно
если с доп.столбцом, то не так уж мозголомно

Автор - Nic70y
Дата добавления - 27.03.2016 в 08:58
МВТ Дата: Воскресенье, 27.03.2016, 10:04 | Сообщение № 6
Группа: Проверенные
Ранг: Обитатель
Сообщений: 475
Репутация: 136 ±
Замечаний: 0% ±

Excel 2007
С учетом того, что данные могут не только добавляться, но и (теоретически) изменяться, что в дальнейшем может приводить к путанице, я бы сделал так
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("C2:C" & Cells(Rows.Count, "C").End(xlUp).Row)) Is Nothing Then Exit Sub
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim Col1 As New Collection, Col2 As New Collection
    Dim arr(), I As Long
    Set ws1 = Worksheets("блок1"): Set ws2 = Worksheets("блок2")
    ws1.Range("A2:B" & ws1.Cells(Rows.Count, "B").End(xlUp).Row).ClearContents
    ws2.Range("A2:B" & ws2.Cells(Rows.Count, "B").End(xlUp).Row).ClearContents
    arr = Range("B2:C" & Cells(Rows.Count, "C").End(xlUp).Row).Value
    For I = 1 To UBound(arr)
        If arr(I, 2) = "блок1" Then
            Col1.Add arr(I, 1)
        ElseIf arr(I, 2) = "блок2" Then
            Col2.Add arr(I, 1)
        End If
    Next
    With Col1
        ReDim arr(1 To .Count, 1 To 2)
        For I = 1 To .Count
            arr(I, 1) = I
            arr(I, 2) = .Item(I)
        Next
        ws1.Range("A2").Resize(UBound(arr), 2).Value = arr
    End With
    With Col2
        ReDim arr(1 To .Count, 1 To 2)
        For I = 1 To .Count
            arr(I, 1) = I
            arr(I, 2) = .Item(I)
        Next
        ws2.Range("A2").Resize(UBound(arr), 2).Value = arr
    End With
End Sub
[/vba]
 
Ответить
СообщениеС учетом того, что данные могут не только добавляться, но и (теоретически) изменяться, что в дальнейшем может приводить к путанице, я бы сделал так
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("C2:C" & Cells(Rows.Count, "C").End(xlUp).Row)) Is Nothing Then Exit Sub
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim Col1 As New Collection, Col2 As New Collection
    Dim arr(), I As Long
    Set ws1 = Worksheets("блок1"): Set ws2 = Worksheets("блок2")
    ws1.Range("A2:B" & ws1.Cells(Rows.Count, "B").End(xlUp).Row).ClearContents
    ws2.Range("A2:B" & ws2.Cells(Rows.Count, "B").End(xlUp).Row).ClearContents
    arr = Range("B2:C" & Cells(Rows.Count, "C").End(xlUp).Row).Value
    For I = 1 To UBound(arr)
        If arr(I, 2) = "блок1" Then
            Col1.Add arr(I, 1)
        ElseIf arr(I, 2) = "блок2" Then
            Col2.Add arr(I, 1)
        End If
    Next
    With Col1
        ReDim arr(1 To .Count, 1 To 2)
        For I = 1 To .Count
            arr(I, 1) = I
            arr(I, 2) = .Item(I)
        Next
        ws1.Range("A2").Resize(UBound(arr), 2).Value = arr
    End With
    With Col2
        ReDim arr(1 To .Count, 1 To 2)
        For I = 1 To .Count
            arr(I, 1) = I
            arr(I, 2) = .Item(I)
        Next
        ws2.Range("A2").Resize(UBound(arr), 2).Value = arr
    End With
End Sub
[/vba]

Автор - МВТ
Дата добавления - 27.03.2016 в 10:04
AlexM Дата: Воскресенье, 27.03.2016, 10:44 | Сообщение № 7
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3053
Репутация: 740 ±
Замечаний: 0% ±



Номер мобильного модема (без голосовой связи)
9269171249 МегаФон, Московский регион.
 
Ответить
СообщениеКросс

Автор - AlexM
Дата добавления - 27.03.2016 в 10:44
StoTisteg Дата: Воскресенье, 27.03.2016, 13:50 | Сообщение № 8
Группа: Авторы
Ранг: Ветеран
Сообщений: 541
Репутация: 45 ±
Замечаний: 0% ±

Excel 2010
данные могут не только добавляться, но и (теоретически) изменяться

Ну да, именно это я и имел в виду под
это явно сыро...


Проверь всё. ThisWorkbook.Save. On Error Resume Next.
 
Ответить
Сообщение
данные могут не только добавляться, но и (теоретически) изменяться

Ну да, именно это я и имел в виду под
это явно сыро...

Автор - StoTisteg
Дата добавления - 27.03.2016 в 13:50
Мир MS Excel » Вопросы и решения » Вопросы по Excel » автоматическое добавление строки (Формулы/Formulas)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2016 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!