ReSQL.ru
     
powered by simpleCommunicator - 2.0.59     © 2025 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Помогите доделать макрос в Екселе
4 сообщений из 4, страница 1 из 1
Помогите доделать макрос в Екселе
    #36240125
Bream
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
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, 16:03
| Ответить | Цитировать | Написать  
Помогите доделать макрос в Екселе
    #36240748
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
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:29
| Ответить | Цитировать | Написать  
Помогите доделать макрос в Екселе
    #36240762
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hugo121
Гость
Иэвините, немного строки спутал:
Код: plaintext
1.
2.
3.
Next x
'====end=добавлено=====
такая правильная редакция, на работу не влияет :)
...
Рейтинг: 0 / 0
08.10.2009, 21:43
| Ответить | Цитировать | Написать  
Помогите доделать макрос в Екселе
    #36240986
Bream
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Bream
Гость
Огромнейшее спасибо!!! Работает, так как надо!
...
Рейтинг: 0 / 0
09.10.2009, 07:12
| Ответить | Цитировать | Написать  
4 сообщений из 4, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Помогите доделать макрос в Екселе
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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