Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
перенос данных по дате и имени
 
Здравствуйте! Подскажите, пожалуйста, как можно из таблицы файла grafik перенести время (начало и конец рабочего времени, 2 столбца рядом) в таблицу файла vremja, учитывая к кому это время относится и дату. При том, что данные находятся на разных листах? =)
 
При условии, что открыты обе книги и ФИО встречается на каждом из листов
книги 'vremja.xls' один раз.
Код в модуль листа 'names' книги vremja
Код
Sub Perenos()
Dim VremjaBook As Workbook
Dim ws As Worksheet
Dim iName As String
Dim FoundName As Range
Dim FoundDate As Range
Dim iDate As Date
Dim i As Long
Dim iLastRow As Long
Dim n As Integer
    iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
        Set VremjaBook = Workbooks("vremja.xls")
    For i = 2 To iLastRow       ' цикл по именам
      If Not IsEmpty(Cells(i, 1)) And Cells(i, 1) <> "Name" Then
        iName = Cells(i, 1)
        iDate = Cells(i, 2)
        For Each ws In VremjaBook.Worksheets 'цикл по листам
          With ws
          Set FoundName = .Columns(1).Find(iName, , xlValues, xlWhole)
           If Not FoundName Is Nothing Then
             Set FoundDate = .Rows(1).Find(iDate, , xlFormulas, xlWhole)
              If Not FoundDate Is Nothing Then
                Cells(i, 3) = .Cells(FoundName.Row, FoundDate.Column)
                Cells(i, 4) = .Cells(FoundName.Row, FoundDate.Column + 1)
              End If
           End If
          End With
        Next ws
      End If
    Next
End Sub
У меня Excel 2003 , поэтому в коде Set VremjaBook = Workbooks("vremja.xls")
Потестируйте!
 
Спасибо огромное!!!
Только Set VremjaBook = Workbooks("grafik.xls") =)))
Еще хотелось бы узнать, как можно пустые ячейки времени заполнить нулями? (0:00)
Еще раз СПАСИБО!!! =)
 
Цитата
как можно пустые ячейки времени заполнить нулями?

В книге grafic на листе 4 в ячейках E1:H 1 текстовый формат, а нужен формат даты
Посмотрите и потестируйте такой вариант
Код
Sub Perenos()
Dim GraficBook As Workbook
Dim ws As Worksheet
Dim iName As String
Dim FoundName As Range
Dim FoundDate As Range
Dim iDate As Date
Dim i As Long
Dim iLastRow As Long
Dim n As Integer
    iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
        Set GraficBook = Workbooks("grafic.xls")
    For i = 2 To iLastRow                           ' цикл по именам
      If Not IsEmpty(Cells(i, 1)) And Cells(i, 1) <> "Name" Then
            iName = Cells(i, 1)
            iDate = Cells(i, 2)
        For Each ws In GraficBook.Worksheets        'цикл по листам
          With ws
          Set FoundName = .Columns(1).Find(iName, , xlValues, xlWhole)
           If Not FoundName Is Nothing Then         'нашли имя, ищем дату
             Set FoundDate = .Rows(1).Find(iDate, , xlFormulas, xlWhole)
              If Not FoundDate Is Nothing Then      'нашли и имя и дату
                                        ' проверяем не пуста ли ячейка
                If Not IsEmpty(.Cells(FoundName.Row, FoundDate.Column)) Then
                  Cells(i, 3) = .Cells(FoundName.Row, FoundDate.Column)
                Else
                  Cells(i, 3) = "0:00"
                End If
                If Not IsEmpty(.Cells(FoundName.Row, FoundDate.Column + 1)) Then
                  Cells(i, 4) = .Cells(FoundName.Row, FoundDate.Column + 1)
                Else
                  Cells(i, 4) = "0:00"
                End If
                    'Set FoundDate = Nothing
                Exit For        'если нашли имя и дату, то выход из цикла
              End If
                    Set FoundName = Nothing 'имя найдено, а даты нет
           Else                 ' не нашли имя на очередном листе
                    Set FoundName = Nothing
                    Set FoundDate = Nothing
           End If
          End With
        Next ws
        If FoundName Is Nothing And FoundDate Is Nothing Then
            Cells(i, 3) = "0:00"
            Cells(i, 4) = "0:00"
        End If
      End If
    Next
End Sub
 
Огромное спасибо, Kuzmich!!! =)
Страницы: 1
Читают тему (гостей: 1)