ReSQL.ru
     
powered by simpleCommunicator - 2.0.51     © 2025 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Поправьте
12 сообщений из 12, страница 1 из 1
Поправьте
    #39083010
Чип&Дейл
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Чип&Дейл
Гость
Добрый день, поправьте пожалуйста макрос p4 в файле.
Должен работать так:
На листе 1 в 3 колонки все шифры услуг по определенному предприятия
На листе 4 в 8 колонке полный перечь услуг
Нужно чтобы на листе 4 остались только те записи что есть на 1 листе.
Макрос работает не совсем правильно, 2 шифра правильные остаются а остальные нет. Файлик выкладываю в архиве.
...
Рейтинг: 0 / 0
22.10.2015, 08:02
| Ответить | Цитировать | Написать  
Поправьте
    #39083020
Проверил
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Проверил
Гость
Чип&ДейлДобрый день, поправьте пожалуйста макрос p4 в файле.
Должен работать так:
На листе 1 в 3 колонки все шифры услуг по определенному предприятия
На листе 4 в 8 колонке полный перечь услуг
Нужно чтобы на листе 4 остались только те записи что есть на 1 листе.
Макрос работает не совсем правильно, 2 шифра правильные остаются а остальные нет. Файлик выкладываю в архиве.

Модератор, вы что спите? Удалите вирус из топика
...
Рейтинг: 0 / 0
22.10.2015, 08:36
| Ответить | Цитировать | Написать  
Поправьте
    #39083025
Чип&Дейл
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Чип&Дейл
Гость
Проверил,

Вы его смотрели, чтобы так смело утверждать что там вирус?
...
Рейтинг: 0 / 0
22.10.2015, 08:56
| Ответить | Цитировать | Написать  
Поправьте
    #39083096
hclubmk
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
hclubmk
Участник
Чип&Дейл
что-то похожее было здесь: 18276758
...
Рейтинг: 0 / 0
22.10.2015, 10:08
| Ответить | Цитировать | Написать  
Поправьте
    #39083301
Чип&Дейл
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Чип&Дейл
Гость
Забавно видеть макрос с programmers который мне написали)
...
Рейтинг: 0 / 0
22.10.2015, 12:12
| Ответить | Цитировать | Написать  
Поправьте
    #39083425
Фотография The_Prist
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
The_Prist
Участник
Чип&ДейлЗабавно видеть макрос с programmers который мне написалиЭто Вы про какой? В теме по ссылке мой код. И он ни разу не с programmers. Как бы не наоборот :-)
...
Рейтинг: 0 / 0
22.10.2015, 13:08
| Ответить | Цитировать | Написать  
Поправьте
    #39083468
Чип&Дейл
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Чип&Дейл
Гость
Про вот этот
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
Sub t()
    Set Sh1 = Sheets(1)
    Set sh2 = Sheets(2)
    lrow1 = Sh1.Cells(Sh1.Rows.Count, "A").End(xlUp).Row
    lrow2 = sh2.Cells(sh2.Rows.Count, "A").End(xlUp).Row
    j = 1
        Do While j <= lrow2
            sh2.Cells(j, 2).FormulaR1C1 = "=COUNTIF(Лист1!C1,Лист2!RC[-1])"
            If sh2.Cells(j, 2) = 0 Then
                sh2.Rows(j).Delete
                row2 = sh2.Cells(sh2.Rows.Count, "A").End(xlUp).Row
            Else:
                sh2.Cells(j, 2).Clear
                j = j + 1
            End If
        Loop
End Sub



Решил сделать вот так, но ничего не копируется, где я косячу?
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
Set sh = Sheets(1)
Set sh1 = Sheets(2)
Set sh2 = Sheets(3)
j = 1
lrow = sh.Cells(Rows.Count, 3).End(xlUp).Row 'последняя заполненная ячейка листа 1
lrow2 = sh1.Cells(Rows.Count, 3).End(xlUp).Row 'последняя заполненная ячейка листа 4
a = 10 'счетчик для вставки в нужну строку
Do While j <= lrow
    w = 1
   Do While w <= lrow2
    If sh.Cells(j, 3) = sh1.Cells(w, 3) Then
    
    sh1.Range(sh1.Cells(10, 4), sh1.Cells(10, 22)).Copy
    Sheets(3).Cells(a, 1).PasteSecial
    a = a + 1
End If
w = w + 1
Loop
j = j + 1
Loop
...
Рейтинг: 0 / 0
22.10.2015, 13:26
| Ответить | Цитировать | Написать  
Поправьте
    #39083480
Фотография The_Prist
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
The_Prist
Участник
Чип&Дейл,

Файл какой для проверки использовать? Тот, что в первом сообщении? Пошагово пробовали выполнять код и смотреть что у Вас там в ячейках сравниваемых? Может реально копировать нечего, т.к. ничего не сходится.

После PasteSecial лучше указывать что именно вставлять. Если все, то PasteSecial вообще не нужен:
Код: vbnet
1.
sh1.Range(sh1.Cells(10, 4), sh1.Cells(10, 22)).Copy Sheets(3).Cells(a, 1).PasteSecial


Ну а сам код как-то кривовато написан...Я бы как минимум циклы так сделал:
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
Set sh = Sheets(1)
Set sh1 = Sheets(2)
Set sh2 = Sheets(3)
lrow = sh.Cells(Rows.Count, 3).End(xlUp).Row 'последняя заполненная ячейка листа 1
lrow2 = sh1.Cells(Rows.Count, 3).End(xlUp).Row 'последняя заполненная ячейка листа 4 - почему 4, а не 3?!!!
a = 10 'счетчик для вставки в нужну строку
For j = 1 to lrow
   For w = 1 to lrow2
    If sh.Cells(j, 3) = sh1.Cells(w, 3) Then
        sh1.Range(sh1.Cells(10, 4), sh1.Cells(10, 22)).Copy
        sh2.Cells(a, 1).PasteSecial xlPasteValues 'вставляем только значения
        a = a + 1
    End If
   Next w
Next j


Ну а оптимально в массивах обрабатывать.
...
Рейтинг: 0 / 0
22.10.2015, 13:34
| Ответить | Цитировать | Написать  
Поправьте
    #39083509
Чип&Дейл
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Чип&Дейл
Гость
The_Prist,

Я плохо понимаю массивы.
sh2.Cells(a, 1).PasteSecial xlPasteValues Вылетала ошибка, пропущена p. Происходит копирование первой строки с листа 4 а должно происходить копирование когда нашлось совпадение
...
Рейтинг: 0 / 0
22.10.2015, 13:50
| Ответить | Цитировать | Написать  
Поправьте
    #39083511
Чип&Дейл,
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Чип&Дейл,
Гость
Да, для проверки файл что в первом сообщении
...
Рейтинг: 0 / 0
22.10.2015, 13:51
| Ответить | Цитировать | Написать  
Поправьте
    #39083550
Чип&Дейл
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Чип&Дейл
Гость
Поправил, но все равно косячно работает :(

Set sh = Sheets(1)
Set sh1 = Sheets(2)

lrow = sh.Cells(Rows.Count, 3).End(xlUp).Row 'ïîñëåäíÿÿ çàïîëíåííàÿ ÿ÷åéêà ëèñòà 1
lrow2 = sh1.Cells(Rows.Count, 3).End(xlUp).Row 'ïîñëåäíÿÿ çàïîëíåííàÿ ÿ÷åéêà ëèñòà 4 - ïî÷åìó 4, à íå 3?!!!
a = 10 'ñ÷åò÷èê äëÿ âñòàâêè â íóæíó ñòðîêó
For j = 10 To lrow
For w = 1 To lrow2
If sh.Cells(j, 3) = sh1.Cells(w, 8) Then
sh1.Range(sh1.Cells(w, 4), sh1.Cells(w, 22)).Copy
Sheets(3).Cells(a, 1).PasteSpecial xlPasteValues 'âñòàâëÿåì òîëüêî çíà÷åíèÿ
a = a + 1
End If
Next w
Next j
...
Рейтинг: 0 / 0
22.10.2015, 14:06
| Ответить | Цитировать | Написать  
Поправьте
    #39083830
Фотография The_Prist
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
The_Prist
Участник
Чип&Дейлпервой строки с листа 4Так у Вас на лист5 уже есть данные аж до 285-й строки. А Вы с 10-й туда данные переносите. Т.е. затираете те данные, что были до этого. Уверены, что так надо? Лист очищать не надо перед этим? Или может быть в конец листа данные вставлять, а не с 10-й строки?
Так же непонятно почему на первых двух листах данные просматриваете с 1-ой строки, когда данные начинаются тоже с 10-ой.
Я вот проверил с 10-й - совпадение нет. Да и вряд ли будут. У Вас сравнение идет по 3-ему столбцу, в котором для первого листа(Лист1) "Шифр услуги", а для второго(Лист4) "Наименование услуги". Совпадений там не было вероятно никогда. И вряд ли будут. Скорее правильнее со вторым столбцом на Лист4 сравнивать, а не с 4-ым.
Тогда и копировать будет.
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
Sub p7()

Set sh = Sheets(1)
Set sh1 = Sheets(2)
Set sh2 = Sheets(3)
lrow = sh.Cells(Rows.Count, 3).End(xlUp).Row 'последняя заполненная ячейка листа 1
lrow2 = sh1.Cells(Rows.Count, 3).End(xlUp).Row 'последняя заполненная ячейка листа 4 - почему 4, а не 3?!!!
a = 10 'счетчик для вставки в нужну строку
For j = 10 To lrow
   For w = 10 To lrow2
    If sh.Cells(j, 3) = sh1.Cells(w, 2) Then
        sh1.Range(sh1.Cells(10, 4), sh1.Cells(10, 22)).Copy
        sh2.Cells(a, 1).PasteSecial xlPasteValues 'вставляем только значения
        a = a + 1
    End If
   Next w
Next j
End Sub
...
Рейтинг: 0 / 0
22.10.2015, 15:51
| Ответить | Цитировать | Написать  
12 сообщений из 12, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Поправьте
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение
NoSQL.ru       Новости, Чат       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=60&msg=39083830&tid=2155753]:
 0ms
get settings:
 9ms
get forum list:
 14ms
check forum access:
 4ms
check topic access:
 4ms
track hit:
 30ms
get topic data:
 11ms
get forum data:
 3ms
get page messages:
 50ms
get tp. blocked users:
 1ms
others: 16ms
total:  142ms
созд. / загр.: 142ms
x
x
Закрыть


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