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

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

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

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

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

textual
Листинг программы
  1. Option Explicit
  2.  
  3. Sub ImportData()
  4.     Dim fd As FileDialog, vrtSelectedItem As Variant, wbk As Workbook
  5.    
  6.     Set fd = Application.FileDialog(msoFileDialogFilePicker)
  7.    
  8.     fd.AllowMultiSelect = True
  9.     fd.Filters.Add "Книга Microsoft Office Excel (*.xls)", "*.xls", 1
  10.    
  11.     If fd.Show = -1 Then
  12.         For Each vrtSelectedItem In fd.SelectedItems
  13.             Set wbk = Workbooks.Open(vrtSelectedItem, False)
  14.             Call EnumWorksheets(wbk)
  15.             wbk.Close
  16.             Set wbk = Nothing
  17.         Next vrtSelectedItem
  18.     End If
  19.    
  20.     Set fd = Nothing
  21. End Sub
  22.  
  23. Private Sub EnumWorksheets(wbk As Workbook)
  24.     Dim src As Worksheet, i As Long, j As Long, m As Long, n As Long
  25.    
  26.     Set src = wbk.Worksheets(1)
  27.    
  28.     For n = Me.UsedRange.Row + Me.UsedRange.Rows.Count - 1 To 1 Step -1
  29.         If Me.Rows(n).Text = "" Then Else Exit For
  30.     Next
  31.    
  32.     For m = src.UsedRange.Row + src.UsedRange.Rows.Count - 1 To 1 Step -1
  33.         If src.Rows(m).Text = "" Then Else Exit For
  34.     Next
  35.    
  36.     i = 2
  37.     Do While i <= m
  38.         If src.Cells(i, 1).Value <> Empty Or src.Cells(i, 2).Value <> Empty Then
  39.             j = 2
  40.             Do While j <= n
  41.                 If src.Cells(i, 1).Value = Me.Cells(j, 1).Value And src.Cells(i, 2).Value = Me.Cells(j, 2).Value Then
  42.                 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
  43.                     Me.Cells(j, 6).Value = src.Cells(i, 6).Value
  44.                     Me.Cells(j, 7).Value = src.Cells(i, 7).Value
  45.                     Me.Cells(j, 8).Value = src.Cells(i, 8).Value
  46.                     Exit Do
  47.                 End If
  48.                 End If
  49.                 j = j + 1
  50.             Loop
  51.         End If
  52.         i = i + 1
  53.     Loop
  54. End Sub

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


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

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

15   голосов , оценка 3.8 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут
Похожие ответы