Перенос данных из одной таблицы в другую - VBA

Узнай цену своей работы

Формулировка задачи:

Здравствуйте! Помогите пожалуйста. Задача состоит в следующем: есть 3 xl книги (ИТОГ, май ОО и ОТС), нужно перенести данные (столбцы : план 2011 (наша заявка), кз и авансы) 1го листа из таблиц ОО и ОТС в соответствующие листы таблицы ИТОГ. Дело в том, что данные должны переносится в соответствии со значениями столбцов "Бюджетные статьи" и "Код ресурсов". Нужно сделать это с помощью макросов. Если есть идеи, поделитесь пожалуйста)

Решение задачи: «Перенос данных из одной таблицы в другую»

textual
Листинг программы
Option Explicit
 
Sub ImportData()
    Dim fd As FileDialog, vrtSelectedItem As Variant, wbk As Workbook
    
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    
    fd.AllowMultiSelect = True
    fd.Filters.Add "Книга Microsoft Office Excel (*.xls)", "*.xls", 1
    
    If fd.Show = -1 Then
        For Each vrtSelectedItem In fd.SelectedItems
            Set wbk = Workbooks.Open(vrtSelectedItem, False)
            Call EnumWorksheets(wbk)
            wbk.Close
            Set wbk = Nothing
        Next vrtSelectedItem
    End If
    
    Set fd = Nothing
End Sub
 
Private Sub EnumWorksheets(wbk As Workbook)
    Dim src As Worksheet, i As Long, j As Long, m As Long, n As Long
    
    Set src = wbk.Worksheets(1)
    
    For n = Me.UsedRange.Row + Me.UsedRange.Rows.Count - 1 To 1 Step -1
        If Me.Rows(n).Text = "" Then Else Exit For
    Next
    
    For m = src.UsedRange.Row + src.UsedRange.Rows.Count - 1 To 1 Step -1
        If src.Rows(m).Text = "" Then Else Exit For
    Next
    
    i = 2
    Do While i <= m
        If src.Cells(i, 1).Value <> Empty Or src.Cells(i, 2).Value <> Empty Then
            j = 2
            Do While j <= n
                If src.Cells(i, 1).Value = Me.Cells(j, 1).Value And src.Cells(i, 2).Value = Me.Cells(j, 2).Value Then
                If Left(Me.Cells(j, 6).FormulaR1C1, 1) <> "=" And Left(Me.Cells(j, 7).FormulaR1C1, 1) <> "=" And Left(Me.Cells(j, 8).FormulaR1C1, 1) <> "=" Then
                    Me.Cells(j, 6).Value = src.Cells(i, 6).Value
                    Me.Cells(j, 7).Value = src.Cells(i, 7).Value
                    Me.Cells(j, 8).Value = src.Cells(i, 8).Value
                    Exit Do
                End If
                End If
                j = j + 1
            Loop
        End If
        i = i + 1
    Loop
End Sub

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

15   голосов , оценка 3.8 из 5
Похожие ответы