Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Помогите доделать макрос в Екселе / 4 сообщений из 4, страница 1 из 1
08.10.2009, 16:03
    #36240125
Bream
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите доделать макрос в Екселе
Доброго времени суток всем! Поставили вот такую задачу:

авторНаписать макрос, выполняющий следующие действия:

1. В файле «база.xls» из диапазона значений столбца «Артикул» найти соответствующие значения для столбца «Артикул» в файле «прайс.xls».

2. Если соответствия найдены, то в файле «прайс.xls» заполнить соответствующие строки значениями из столбцов файла «база.xls»:
Код ID, Маленькая картинка, Подробное описание, Большая картинка, Категория.

3. Если соответствующие значение не найдены из диапазона ячеек столбца «Артикул» «база.xls» в столбце «Артикул» «прайс.xls», то эти (ненайденные) позиции из «база.xls» добавить в «прайс.xls» с сохранением всех значений столбцов (база.xls), кроме столбца «Склад» его значение установить в 0 (ноль).

С первыми двумя пунктами справился, а вот с добавлением позиций из "базы" в "прайс" никак :(

авторSub Main()
Dim i As Integer
Dim j As Integer
Workbooks.Open ("C:\Macro\прайс.xls")
Workbooks.Open ("C:\Macro\база.xls")
Workbooks("прайс.xls").Sheets("прайс").Activate
With Workbooks("база.xls").Sheets("база")
For i = 2 To Cells(Rows.Count, "N").End(xlUp).Row
For j = 2 To .Cells(Rows.Count, "N").End(xlUp).Row
If Cells(i, "N") = .Cells(j, "N") Then
Cells(i, "A") = .Cells(j, "A")
Cells(i, "D") = .Cells(j, "D")
Cells(i, "E") = .Cells(j, "E")
Cells(i, "F") = .Cells(j, "F")
Cells(i, "G") = .Cells(j, "G")
Cells(i, "O") = .Cells(j, "O")
End If
Next j
Next i
Workbooks("прайс.xls").Close savechanges:=True
Workbooks("база.xls").Close savechanges:=False
End With
End Sub

Может подскажите какие-нибудь идеи? Заранее огромное спасибо!
...
Рейтинг: 0 / 0
08.10.2009, 21:29
    #36240748
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите доделать макрос в Екселе
Доделал Ваш код. Я бы писал всё немного иначе, ну да ладно, и так работает:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
Sub Main()
Dim i As Integer
Dim j As Integer
'====добавлено=========
Application.ScreenUpdating = False ' чтобы не мельтешило
'====end=добавлено=====

Workbooks.Open ("C:\Macro\прайс.xls")
Workbooks.Open ("C:\Macro\база.xls")
Workbooks("прайс.xls").Sheets("прайс").Activate
With Workbooks("база.xls").Sheets("база")
For i =  2  To Cells(Rows.Count, "N").End(xlUp).Row
For j =  2  To .Cells(Rows.Count, "N").End(xlUp).Row
If Cells(i, "N") = .Cells(j, "N") Then
Cells(i, "A") = .Cells(j, "A")
Cells(i, "D") = .Cells(j, "D")
Cells(i, "E") = .Cells(j, "E")
Cells(i, "F") = .Cells(j, "F")
Cells(i, "G") = .Cells(j, "G")
Cells(i, "O") = .Cells(j, "O")
'====добавлено=========
.Cells(j, "Q").Value = "Copied"
Application.StatusBar = "Copied " & j & " Row"    ' Это для визуализации работы макроса
'====end=добавлено=====
End If
Next j
Next i

'====добавлено=========
For x =  2  To .Cells(Rows.Count, "N").End(xlUp).Row
If .Cells(x, "Q").Value <> "Copied" Then
Cells(i, "A") = .Cells(x, "A")
Cells(i, "D") = .Cells(x, "D")
Cells(i, "E") = .Cells(x, "E")
Cells(i, "F") = .Cells(x, "F")
Cells(i, "G") = .Cells(x, "G")
Cells(i, "O") = .Cells(x, "O")
'->тут откорректировать "кроме столбца «Склад» его значение установить в 0 (ноль)"
' типа Cells(i, "O") = 0
Application.StatusBar = "Copied " & x & " Row"    ' Это для визуализации работы макроса
i = i +  1 
End If
'====end=добавлено=====

Next x
Workbooks("прайс.xls").Close savechanges:=True
Workbooks("база.xls").Close savechanges:=False
End With

'====добавлено=========
Application.StatusBar = False
Application.ScreenUpdating = True
'====end=добавлено=====
End Sub
Проверьте в работе, может где что не так...
...
Рейтинг: 0 / 0
08.10.2009, 21:43
    #36240762
Hugo121
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите доделать макрос в Екселе
Иэвините, немного строки спутал:
Код: plaintext
1.
2.
3.
Next x
'====end=добавлено=====

такая правильная редакция, на работу не влияет :)
...
Рейтинг: 0 / 0
09.10.2009, 07:12
    #36240986
Bream
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите доделать макрос в Екселе
Огромнейшее спасибо!!! Работает, так как надо!
...
Рейтинг: 0 / 0
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Помогите доделать макрос в Екселе / 4 сообщений из 4, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]