ReSQL.ru
     
powered by simpleCommunicator - 2.0.59     © 2025 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / поиск уникальных значений
4 сообщений из 4, страница 1 из 1
поиск уникальных значений
    #36945552
fedoamx
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
fedoamx
Участник
Проблема такая, нужно выбрать уникальные значения с листа 2 и добавить их в лист 1. А в итоге он мне вставляет все значения листа 2.

Код: 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.
Public Sub sdf()
Dim i, k, m, j As Integer
Dim LastRow  As Integer
Dim LastRow2 As Integer
Dim list1() As Variant
Dim list2() As Variant
Dim lFlag As Boolean

LastRow = ThisWorkbook.Sheets("2").Cells(Rows.Count,  1 ).End(xlUp).Row   '=326, значения с 6ой строки
LastRow2 = ThisWorkbook.Sheets("1").Cells(Rows.Count,  1 ).End(xlUp).Row +  1  '=399, также с 6ой строки

For m =  6  To LastRow -  5 
ReDim Preserve list1(m)
    list1(m) = ActiveWorkbook.Worksheets("2").Cells(m,  2 ).Value
Next m

For k =  6  To LastRow2 -  5 
ReDim Preserve list2(k)
    list2(k) = ActiveWorkbook.Worksheets("1").Cells(k,  3 ).Value
Next k


For i =  6  To UBound(list1)
  lFlag = False
  For j =  6  To UBound(list2)
    If list2(j) = list1(i) Then
       lFlag = True
       Exit For
    End If
  Next j
  If lFlag = False Then
    ReDim Preserve list2(UBound(list2) +  1 ) 'увеличиваем предел на +1
    list2(UBound(list2)) = list1(i) 'вставляем в конец массива не найденный элемент листа1
  End If
Next i


For i =  6  To UBound(list2) -  1 
        ActiveWorkbook.Worksheets("1").Cells(i,  3 ).Value = list2(i)
Next i
...
Рейтинг: 0 / 0
09.11.2010, 17:41
| Ответить | Цитировать | Написать  
поиск уникальных значений
    #36945684
Ребус
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Ребус
Участник
fedoamx, зачем с массивами заморачиваться ?
 
Оставьте эту радость Эксэлю
Код: 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.
Public Sub sdf()
Dim rng, rngFind
Dim i%, j%
Dim FirstRow%, LastRow%, Column_%
Dim FirstRow2%, LastRow2%, Column_2%
'Dim list1() As Variant
'Dim list2() As Variant
'Dim lFlag As Boolean

Column_ =  2    ' столбец на листе "2" из которого читаются данные
Column_2 =  3   ' столбец на листе "1" в который добавляются данные

FirstRow =  6      ' начало таблицы данных на листе "2"
FirstRow2 =  6    ' начало таблицы данных на листе "1"

' последняя строка с данными на листе "2"
LastRow = ThisWorkbook.WorkSheets("2").Cells(Rows.Count, Column_).End(xlUp).Row 
' последняя строка с данными на листе "1"
LastRow2 = ThisWorkbook.WorkSheets("1").Cells(Rows.Count, Column_2).End(xlUp).Row

With ThisWorkbook.WorkSheets("1")
    Set rng = .Range(.Cells(FirstRow2, Column_2), _
                     .Cells(LastRow2 + LastRow - FirstRow +  1 , Column_2)
End With

j = LastRow2 +  1 

With ThisWorkbook.WorkSheets("2")
For i = FirstRow to LastRow
  Set rngFind = rng.Find(What:= .Cells(i, Column_).Value, _
                          LookIn:=xlValues, LookAt:=xlWhole)
  If rngFind Is Nothing Then
     ThisWorkbook.WorkSheets("1").Cells(j, Column_2).Value = .Cells(i, Column_).Value
     j = j +  1 
  End If
Next i
Set  rngFind = Nothing
End With

End Sub
...
Рейтинг: 0 / 0
09.11.2010, 18:35
| Ответить | Цитировать | Написать  
поиск уникальных значений
    #36945974
fedoamx
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
fedoamx
Участник
Ребус,
Спасибо большое, как вариант,очень и очень понравилось!
__________

А есть у кого мысли по поводу моего кода, мучился, хочется увидеть у себя ошибку?
...
Рейтинг: 0 / 0
09.11.2010, 22:54
| Ответить | Цитировать | Написать  
поиск уникальных значений
    #36946139
Ребус
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Ребус
Участник
fedoamx,
 
что бросается в глаза (ИМХО):- диапазоны с данными на листах "1" и "2" находятся в столбцах 3 и 2 соответственно, а последние заполненные строки ( LastRow2, LastRow ) определяются на обоих листах по столбцу 1;
- в массивы считываются не все строки из диапазонов данных ( k= ... To LastRow2 - 5 );
- не используются первые элементы элементов массивов
Код: plaintext
1.
2.
3.
ReDim Preserve list2(верхняя_граница_индекса)
' вместо
ReDim Preserve list2(нижняя_граница_индекса To верхняя_граница_индекса)
- первоначальная инициализация массивов в цикле
Код: plaintext
1.
2.
3.
For k =  6  To LastRow2 -  5 
ReDim Preserve list2(k)
'    ...
Next k
вместо
Код: plaintext
1.
2.
3.
4.
ReDim list2(LastRow2 -  5 )
' так и не понял, откуда взялось это - 5 ...
For k =  6  To LastRow2 -  5 
'    ...
Next k
- переинициализация массива list2 в цикле
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
For i =  6  To UBound(list1)
' ....
  If lFlag = False Then
    ReDim Preserve list2(UBound(list2) +  1 ) 'увеличиваем предел на +1
    list2(UBound(list2)) = list1(i) 'вставляем в конец массива не найденный элемент листа1
  End If
Next i

For i =  6  To UBound(list2) -  1 
' (!) при верхней границе индекса UBound(list2) - 1 
' (!) пропускается последний элемент из массива list2
        ActiveWorkbook.Worksheets("1").Cells(i,  3 ).Value = list2(i)
Next i
вместо
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
k = UBound(list2)
ReDim Preserve list2(UBound(list2) + UBound(list1) -  6  +  1 )
' UBound(list2) + UBound(list1) - 6 + 1 - для наглядности, 
' лучше было бы использовать переменые LastRow и  LastRow2

For i =  6  To UBound(list1)
  lFlag = True
  For j =  6  To k
    If list2(j) = list1(i) Then
       lFlag = False
       Exit For
    End If
  Next j
  If lFlag Then
    k = k +  1 
    list2(k) = list1(i)
  End If
Next i

For i =  6  To k
        ActiveWorkbook.Worksheets("1").Cells(i,  3 ).Value = list2(i)
Next i
ЗЫ: сорри за "многабукаф"
ЗЗЫ: чтобы сказать почему Ваш код на Ваших данных не дает ожидаемых результатов, - нужен пример файла.
...
Рейтинг: 0 / 0
10.11.2010, 03:36
| Ответить | Цитировать | Написать  
4 сообщений из 4, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / поиск уникальных значений
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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