Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Подстановка значения IP при условии, что 2 параметра соответствую заданным, не выполняется условие в макросе
 
#1
23.09.2020 09:28:24
Добрый день, прошу помочь разобраться в проблеме. Написала макрос для переноса по условию, но условие не выполняется, данные просто копируются. Скорее всего, я некорректно задала само условие, но найти ошибку не могу

Суть: Есть лист "1" и "2", три колонки везде A,B,C.
На первом листе условия А = ID, B = номер договора, С = пустой столбец, в него нужно вставить данные из листа "2"
На втором листе  А = ID, B = номер договора, С =  данные.    
Условие - чтобы данные присваивались, если ID и номер клиента совпадают
Код
Sub Перенос()
With Worksheets("1")
Ir = 2
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
 If Range("A" & i).Value = Range("A" & i) And Range("B" & i).Value = Range("B" & i) Then
     .Range("C" & Ir).Value = Range("C" & i).Value
     Ir = Ir + 1
 End If
 Next
 End With
End Sub
 
 
 
#2
23.09.2020 09:32:40
Sne mart, приложите файл-пример с
Цитата
Sne mart написал:
Есть лист "1" и "2", три колонки везде A,B,C.
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#3
23.09.2020 09:37:34
Упрощенный пример  
 
 
 
#4
23.09.2020 09:38:57
Цитата
Sne mart написал:
With Worksheets("1")
это используете.
А вот точки перед Range - не везде. Присмотритесь что с чем сравниваете - сравнение идет с данными на одном листе - текущем:
Код
Range("A" & i).Value = Range("A" & i)
т.е. здесь сравнение ячейки столбца А с самой собой. А надо явно перед одним Range точку поставить, чтобы обозначить другой лист.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#5
23.09.2020 09:48:47
Sne mart,
Код
Sub Перенос()
With Worksheets("1")
lr = .Cells(Rows.Count, 1).End(xlUp).Row 'последняя заполненная строка в столбце А листа 1
lr2 = Worksheets("2").Cells(Rows.Count, 1).End(xlUp).Row 'последняя заполненная строка в столбце А листа 2
For i = 2 To lr 'цикл по строкам листа 1
    For n = 2 To lr2  'цикл по строкам листа 2
        If .Range("A" & i) = Worksheets("2").Range("A" & n) And .Range("B" & i) = Worksheets("2").Range("B" & n) Then
            .Range("C" & i) = Worksheets("2").Range("C" & n)
            Exit For
        End If
    Next n
Next i
End With
End Sub
Изменено: Mershik - 23.09.2020 09:50:39
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#6
23.09.2020 10:47:41
Mershik, ооо боги, все заработало. Спасибо вам большое!!!!
Теперь буду знать, как правильно условие писать, нужно было и лист прописывать, спасибо еще раз!!
 
 
 
#7
23.09.2020 10:53:26
Теперь еще узнайте из правил форума, как тему называть, и предложите новое название. Заменят модераторы
 
 
 
#8
23.09.2020 11:03:19
vikttur, раз уж помог я)
Тема Подстановка значения IP при условии, что 2 параметра соответствую заданным
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#9
23.09.2020 11:03:51
Цитата
Sne mart написал:
ооо боги
что, есть такое ООО? ИНН не подскажете? :)
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
 
 
 
#10
23.09.2020 11:20:20
Михаил Лебедев, 7726332658 - вот пожалуйста
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#11
23.09.2020 11:57:03
Добрый день, а если подстановка нужна не значений а суммы значений IP при наличии в листе 2 нескольких строк c одинаковыми ID и N.
Пример приложил с кодом товарища Mershik
 
 
 
#12
23.09.2020 12:53:21
Григорий Тимофеев, Интересно, но в моем случае столбик IP подразумевать название документа :)  
 
 
 
#13
23.09.2020 14:40:16
мне Ваш случай не подошел )
 
 
 
#14
23.09.2020 19:54:40
Цитата
Mershik написал:
7726332658 - вот пожалуйста
Круто! :)
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
 
 
 
#15
24.09.2020 06:11:00
У меня возникла новая проблема с макросом, он присваивает не все значения. Заполненных ячеек 70000 в документе, когда запускаю макрос, excel зависает минут на 7-10 и обрабатывает всего 315-400 ячеек (каждый раз по-разному).  Везде выставлен один формат, в чем может быть проблема и как его можно ускорить? Самое интересное, если написать формулу, то он присваивает все значения и обрабатывает намного быстрее  
Изменено: Sne mart - 24.09.2020 06:12:09
 
 
 
#16
24.09.2020 06:42:59
Вы бы показали больше реальных данных и показали ещё данные где макрос не подставляет значения что бы понять что не так и изменить его а так гадать на кофейной гуще
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#17
24.09.2020 07:20:05
Даже часть файла слишком много весит, поэтому ссылка https://yadi.sk/d/slctd6qvNsmVlQ?w=1 он присвоил значения только до 615 ячейки и дальше остановился  
 
 
 
#18
24.09.2020 10:06:07
Sne mart, попробуйте такой вариант (нужно будет подождать секунд 20) и на будущее
Цитата
Заполненных ячеек 70000 в документе,
такое нужно писать в 1 сообщении
Код
Sub sdsd()
Dim arr1(), arr2(), arr3()
Dim rng1 As Range, rng2 As Range, i As Long, n As Long
Dim sh1 As Worksheet, sh2 As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set sh1 = Worksheets("1")
Set sh2 = Worksheets("2")
Set rng1 = sh1.Range(sh1.Cells(2, 1), sh1.Cells(sh1.Cells(Rows.Count, 1).End(xlUp).Row, 2))
Set rng2 = sh2.Range(sh2.Cells(2, 1), sh2.Cells(sh2.Cells(Rows.Count, 1).End(xlUp).Row, 3))
lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
arr1 = rng1
arr2 = rng2
k = 0
ReDim arr3(UBound(arr1), 0)
For i = LBound(arr1) To UBound(arr1)
    For n = LBound(arr2) To UBound(arr2)
        If arr1(i, 1) = arr2(n, 1) And arr1(i, 2) = arr2(n, 2) Then
            arr3(i - 1, 0) = arr2(n, 3)
            Exit For
        End If
    Next n
Next i
sh1.Range("C2:C" & UBound(arr1)+1) = arr3
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Изменено: Mershik - 24.09.2020 11:36:54
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#19
25.09.2020 05:18:13
Mershik, Все идеально работает, спасибо ,большое за помощь!!! Хотела еще поинтересоваться, если нам нужно будет помимо столбика "C", также присваивать столбик "D" по тем же условиям. Мы вводим новую переменную, как i и n или просто прописываем в условии, как это сделала я
Спрашиваю, чтобы окончательно понять всё :)  
Код
Sub port()
Dim arr1(), arr2(), arr3(), arr4()
Dim rng1 As Range, rng2 As Range, i As Long, n As Long
Dim sh1 As Worksheet, sh2 As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set sh1 = Worksheets("1")
Set sh2 = Worksheets("2")
Set rng1 = sh1.Range(sh1.Cells(2, 1), sh1.Cells(sh1.Cells(Rows.Count, 1).End(xlUp).Row, 2))
Set rng2 = sh2.Range(sh2.Cells(2, 1), sh2.Cells(sh2.Cells(Rows.Count, 1).End(xlUp).Row, 3))
lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
arr1 = rng1
arr2 = rng2
k = 0
ReDim arr3(UBound(arr1), 0), arr4(UBound(arr1), 0)
For i = LBound(arr1) To UBound(arr1)
    For n = LBound(arr2) To UBound(arr2)
        If arr1(i, 1) = arr2(n, 1) And arr1(i, 2) = arr2(n, 2) Then
            arr3(i - 1, 0) = arr2(n, 3)
            arr4(i - 1, 0) = arr2(n, 4)
              
             Exit For
        End If
    Next n
Next i
sh1.Range("C2:C" & UBound(arr1) + 1) = arr3
sh1.Range("D2:D" & UBound(arr1) + 1) = arr4


Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
 
 
 
#20
25.09.2020 08:51:20
Sne mart, честно без файла мне не понятен вопрос
Не бойтесь совершенства. Вам его не достичь.
 
 
 
Страницы: 1
Наверх