Перенос данных из одной таблицы в другую - 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
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д