Добрый день! Есть основная книга "Закупки.xlsx", в столбец В необходимо скопировать данные из книги "ГГГГ_ММ_ДД_Прайс", где "ГГГГ_ММ_ДД" переменное значение. В книге "*_Прайс" если в столбце А такое же значение как и в столбце А из Книги "Закупки.xlsx", необходимо копировать значение из столбца D "*_Прайс" в столбец В "Закупки.xlsx". Если значение (например Мука)отсутствует, переходим к следующей строке. В каждой скопированной ячейке необходимо оставлять видимые 0 знаков после запятой (в строке формул - полностью скопированное значение с 3 знаками после запятой) и окрашивать в зеленый цвет После этого хотелось бы увидеть MsBox о количестве и названии пропущенных строк, но не обязательно
Добрый день! Есть основная книга "Закупки.xlsx", в столбец В необходимо скопировать данные из книги "ГГГГ_ММ_ДД_Прайс", где "ГГГГ_ММ_ДД" переменное значение. В книге "*_Прайс" если в столбце А такое же значение как и в столбце А из Книги "Закупки.xlsx", необходимо копировать значение из столбца D "*_Прайс" в столбец В "Закупки.xlsx". Если значение (например Мука)отсутствует, переходим к следующей строке. В каждой скопированной ячейке необходимо оставлять видимые 0 знаков после запятой (в строке формул - полностью скопированное значение с 3 знаками после запятой) и окрашивать в зеленый цвет После этого хотелось бы увидеть MsBox о количестве и названии пропущенных строк, но не обязательноakaDemik
SLAVICK, к сожалению ВПР не подходит т.к. файл будет передаваться отдельно и влияет на другие листы также, это будет как первая часть макроса, со второй частью мне помогли
SLAVICK, к сожалению ВПР не подходит т.к. файл будет передаваться отдельно и влияет на другие листы также, это будет как первая часть макроса, со второй частью мне помоглиakaDemik
Sub ertert() Dim x, i&, k&, s$ With CreateObject("Scripting.Dictionary") .CompareMode = 1
With Workbooks("2015_10_30_.xlsx").Sheets(1) x = .Range("A1:D" & .Cells(Rows.Count, 1).End(xlUp).Row).Value End With For i = 1 To UBound(x, 1) If Len(x(i, 1)) Then .Item(x(i, 1)) = x(i, 4) Next i
With Workbooks("7910470.xlsm").Sheets("Еда") ' or Sheets("Питие") :) x = .Range("A1", .Cells(Rows.Count, 1).End(xlUp)).Value End With For i = 1 To UBound(x, 1) If Len(x(i, 1)) Then If .exists(x(i, 1)) Then x(i, 1) = .Item(x(i, 1)) Else s = s & x(i, 1) & Chr(10): x(i, 1) = vbNullString: k = k + 1 End If End If Next i End With
Workbooks("7910470.xlsm").Sheets("Еда").Range("B1").Resize(UBound(x)).Value = x MsgBox "Пропущенная еда в кол-ве: " & k & Chr(10) & Chr(10) & s, 64 End Sub
[/vba]
например, вот (обе книги д.б. открыты):
[vba]
Код
Sub ertert() Dim x, i&, k&, s$ With CreateObject("Scripting.Dictionary") .CompareMode = 1
With Workbooks("2015_10_30_.xlsx").Sheets(1) x = .Range("A1:D" & .Cells(Rows.Count, 1).End(xlUp).Row).Value End With For i = 1 To UBound(x, 1) If Len(x(i, 1)) Then .Item(x(i, 1)) = x(i, 4) Next i
With Workbooks("7910470.xlsm").Sheets("Еда") ' or Sheets("Питие") :) x = .Range("A1", .Cells(Rows.Count, 1).End(xlUp)).Value End With For i = 1 To UBound(x, 1) If Len(x(i, 1)) Then If .exists(x(i, 1)) Then x(i, 1) = .Item(x(i, 1)) Else s = s & x(i, 1) & Chr(10): x(i, 1) = vbNullString: k = k + 1 End If End If Next i End With
Workbooks("7910470.xlsm").Sheets("Еда").Range("B1").Resize(UBound(x)).Value = x MsgBox "Пропущенная еда в кол-ве: " & k & Chr(10) & Chr(10) & s, 64 End Sub
nilem, к сожалению не подходит, т.к.: 1. Есть основная книга, Закупки.xlsx, название может меняться, например Закупки248.xlsx или 10_11_Закупки.xlsx, поэтому в коде лучше не привязываться к конкретному файлу...может лучше ThisWorkbook и srcBook ? вот как будет выглядеть код, в продолжение...
код простой, но рабочий и открывает файлы т.к. мне нужно [vba]
Код
Sub IMPORT() Dim srcBook Set wb = ThisWorkbook Set wf = WorksheetFunction Dim oFileSystemObject As Object: Set oFileSystemObject = CreateObject("Scripting.FileSystemObject") If oFileSystemObject.FileExists(wb.Path & "\Январь.xls") Then Set srcBook = Workbooks.Open(Filename:=wb.Path & "\Январь.xls", ReadOnly:=True, UpdateLinks:=0) wb.Sheets("Главная").Range("B5") = wf.Sum(srcBook.Sheets("1Понедельник").Range("A3,A7,A9,A11")) wb.Sheets("Главная").Range("B6") = wf.Sum(srcBook.Sheets("1Вторник").Range("A3,A7,A9,A11")) wb.Sheets("Главная").Range("B7") = wf.Sum(srcBook.Sheets("1Среда").Range("A3,A7,A9,A11")) wb.Sheets("Главная").Range("B5:B7").Font.Color = vbRed srcBook.Close SaveChanges:=False End If Dim oFileSystemObject As Object: Set oFileSystemObject = CreateObject("Scripting.FileSystemObject") If oFileSystemObject.FileExists(wb.Path & "\Февраль.xls") Then Set srcBook = Workbooks.Open(Filename:=wb.Path & "\Февраль.xls", ReadOnly:=True, UpdateLinks:=0) wb.Sheets("Главная").Range("B9") = wf.Sum(srcBook.Sheets("2Понедельник").Range("A3,A7,A9,A11")) wb.Sheets("Главная").Range("B10") = wf.Sum(srcBook.Sheets("2Вторник").Range("A3,A7,A9,A11")) wb.Sheets("Главная").Range("B11") = wf.Sum(srcBook.Sheets("2Среда").Range("A3,A7,A9,A11")) wb.Sheets("Главная").Range("B12") = wf.Sum(srcBook.Sheets("2Четверг").Range("A3,A7,A9,A11")) wb.Sheets("Главная").Range("B9:B12").Font.Color = vbRed srcBook.Close SaveChanges:=False End If Dim oFileSystemObject As Object: Set oFileSystemObject = CreateObject("Scripting.FileSystemObject") If oFileSystemObject.FileExists(wb.Path & "\Март.xls") Then Set srcBook = Workbooks.Open(Filename:=wb.Path & "\Март.xls", ReadOnly:=True, UpdateLinks:=0) wb.Sheets("Главная").Range("B14") = wf.Sum(srcBook.Sheets("3Понедельник").Range("A3,A7,A9,A11")) wb.Sheets("Главная").Range("B15") = wf.Sum(srcBook.Sheets("3Вторник").Range("A3,A7,A9,A11")) wb.Sheets("Главная").Range("B16") = wf.Sum(srcBook.Sheets("3Среда").Range("A3,A7,A9,A11")) wb.Sheets("Главная").Range("B14:B16").Font.Color = vbRed srcBook.Close SaveChanges:=False 'и так далее... End Sub
[/vba]
2. Второстепенная книга не открыта и название также может быть разное, единственное всегда одинаково окончание - "*_Прайс", то есть ее надо открыть из той папки, где находится основная книга, найти нужные значения и закрыть книгу 3. Ваш пример не округляет и не окрашивает скопированные ячейки
nilem, к сожалению не подходит, т.к.: 1. Есть основная книга, Закупки.xlsx, название может меняться, например Закупки248.xlsx или 10_11_Закупки.xlsx, поэтому в коде лучше не привязываться к конкретному файлу...может лучше ThisWorkbook и srcBook ? вот как будет выглядеть код, в продолжение...
код простой, но рабочий и открывает файлы т.к. мне нужно [vba]
Код
Sub IMPORT() Dim srcBook Set wb = ThisWorkbook Set wf = WorksheetFunction Dim oFileSystemObject As Object: Set oFileSystemObject = CreateObject("Scripting.FileSystemObject") If oFileSystemObject.FileExists(wb.Path & "\Январь.xls") Then Set srcBook = Workbooks.Open(Filename:=wb.Path & "\Январь.xls", ReadOnly:=True, UpdateLinks:=0) wb.Sheets("Главная").Range("B5") = wf.Sum(srcBook.Sheets("1Понедельник").Range("A3,A7,A9,A11")) wb.Sheets("Главная").Range("B6") = wf.Sum(srcBook.Sheets("1Вторник").Range("A3,A7,A9,A11")) wb.Sheets("Главная").Range("B7") = wf.Sum(srcBook.Sheets("1Среда").Range("A3,A7,A9,A11")) wb.Sheets("Главная").Range("B5:B7").Font.Color = vbRed srcBook.Close SaveChanges:=False End If Dim oFileSystemObject As Object: Set oFileSystemObject = CreateObject("Scripting.FileSystemObject") If oFileSystemObject.FileExists(wb.Path & "\Февраль.xls") Then Set srcBook = Workbooks.Open(Filename:=wb.Path & "\Февраль.xls", ReadOnly:=True, UpdateLinks:=0) wb.Sheets("Главная").Range("B9") = wf.Sum(srcBook.Sheets("2Понедельник").Range("A3,A7,A9,A11")) wb.Sheets("Главная").Range("B10") = wf.Sum(srcBook.Sheets("2Вторник").Range("A3,A7,A9,A11")) wb.Sheets("Главная").Range("B11") = wf.Sum(srcBook.Sheets("2Среда").Range("A3,A7,A9,A11")) wb.Sheets("Главная").Range("B12") = wf.Sum(srcBook.Sheets("2Четверг").Range("A3,A7,A9,A11")) wb.Sheets("Главная").Range("B9:B12").Font.Color = vbRed srcBook.Close SaveChanges:=False End If Dim oFileSystemObject As Object: Set oFileSystemObject = CreateObject("Scripting.FileSystemObject") If oFileSystemObject.FileExists(wb.Path & "\Март.xls") Then Set srcBook = Workbooks.Open(Filename:=wb.Path & "\Март.xls", ReadOnly:=True, UpdateLinks:=0) wb.Sheets("Главная").Range("B14") = wf.Sum(srcBook.Sheets("3Понедельник").Range("A3,A7,A9,A11")) wb.Sheets("Главная").Range("B15") = wf.Sum(srcBook.Sheets("3Вторник").Range("A3,A7,A9,A11")) wb.Sheets("Главная").Range("B16") = wf.Sum(srcBook.Sheets("3Среда").Range("A3,A7,A9,A11")) wb.Sheets("Главная").Range("B14:B16").Font.Color = vbRed srcBook.Close SaveChanges:=False 'и так далее... End Sub
[/vba]
2. Второстепенная книга не открыта и название также может быть разное, единственное всегда одинаково окончание - "*_Прайс", то есть ее надо открыть из той папки, где находится основная книга, найти нужные значения и закрыть книгу 3. Ваш пример не округляет и не окрашивает скопированные ячейкиakaDemik