Общее·количество·просмотров·страницы

пятница, 6 августа 2010 г.

Вставить данные из одной таблицы в другую по коду товара

Option Base 1
Dim LastColumnI As Integer, LastRowI As Variant
Dim TemplateFullNameS As String, TemplateSheetS As String, TemplateNameS As String
Dim TemplateDataArrV() As Variant, OrderDataArrV() As Variant
Sub Consolidation()
'On Error Resume Next
'открываем щаблон
Set FSO = CreateObject("Scripting.FileSystemObject")
ThisWorkbook.Worksheets("data").Range("a1").Select
TemplateFullNameS = ActiveCell.Offset(0, 1)
Set File = FSO.GetFile(TemplateFullNameS)

TemplateSheetS = ActiveCell.Offset(1, 1)
TemplateNameS = File.Name
Workbooks.Open Filename:=TemplateFullNameS
ActiveWorkbook.Worksheets(CStr(TemplateSheetS)).Range("a1").Select
LastRowI = ActiveSheet.UsedRange.SpecialCells(xlLastCell).Row
LastColumnI = ActiveSheet.UsedRange.SpecialCells(xlLastCell).Column
TemplateDataArrV = ActiveCell.CurrentRegion.Offset(1, 0).Resize(LastRowI - 1, LastColumnI)
Workbooks(TemplateNameS).Close
'============================================================================================
TemplateFullNameS = ActiveCell.Offset(2, 1)
TemplateSheetS = ActiveCell.Offset(3, 1)
TemplateNameS = File.Name
Workbooks.Open Filename:=TemplateFullNameS
ActiveWorkbook.Worksheets(CStr(TemplateSheetS)).Range("a1").Select
LastRowI = ActiveSheet.UsedRange.SpecialCells(xlLastCell).Row
LastColumnI = ActiveSheet.UsedRange.SpecialCells(xlLastCell).Column
OrderDataArrV = ActiveCell.CurrentRegion.Offset(1, 0).Resize(LastRowI - 1, LastColumnI)
ActiveWorkbook.Close
a = UBound(OrderDataArrV, 1)
b = UBound(TemplateDataArrV, 1)
c = LBound(TemplateDataArrV, 1)
For i = 1 To a
For j = 1 To b
'For k = 1 To c
If OrderDataArrV(i, 1) = TemplateDataArrV(j, 7) And OrderDataArrV(i, 2) = TemplateDataArrV(j, 8) Then
TemplateDataArrV(j, 2) = OrderDataArrV(i, 1)
End If
'Next c
Next j
Next i
End Sub

ссылка на задчку

Комментариев нет:

Отправить комментарий