Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Как изменить макрос? - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Как изменить макрос?
anvvar Дата: Четверг, 23.01.2014, 17:01 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 60% ±

Excel 2010
Есть макрос, который позволяет провести такую сортировку данных:

находит данные приведенные во второй колонке среди данных в первой колонке и выводит их напротив в третьей колонке. Вот сам макрос:

[vba]
Код
Sub zz00()
Dim i As Long, j As Long, kA As Long, kB As Long, B() As String, sT As String
kA = Cells(Rows.Count, 1).End(xlUp).Row
ReDim B(kA)
kB = 0
For i = 1 To kA
sT = Cells(i, 2)
If sT <> "" Then
kB = kB + 1
B(kB) = sT
End If
Next i
For i = 1 To kA
sT = Cells(i, 1)
For j = 1 To kB
If sT = B(j) Then Cells(i, 3) = B(j)
Next j
Next i
End Sub
[/vba]

Вот как это выглядит в результате такой сортировки:


Но, есть одна проблема. Если данные из второй колонки оказываются не найденными среди данных первой колонки, то они просто теряются (такие пометил желтым) :


Нужно изменить макрос, чтобы не найденные данные выводились в четвертую колонку.

В результате должно получаться примерно так:



Заранее всем огромное спасибо!! !
[admin]
Тема закрыта. Причина: Нарушение правил пп. 2, 3, 5r[/admin]
 
Ответить
СообщениеЕсть макрос, который позволяет провести такую сортировку данных:

находит данные приведенные во второй колонке среди данных в первой колонке и выводит их напротив в третьей колонке. Вот сам макрос:

[vba]
Код
Sub zz00()
Dim i As Long, j As Long, kA As Long, kB As Long, B() As String, sT As String
kA = Cells(Rows.Count, 1).End(xlUp).Row
ReDim B(kA)
kB = 0
For i = 1 To kA
sT = Cells(i, 2)
If sT <> "" Then
kB = kB + 1
B(kB) = sT
End If
Next i
For i = 1 To kA
sT = Cells(i, 1)
For j = 1 To kB
If sT = B(j) Then Cells(i, 3) = B(j)
Next j
Next i
End Sub
[/vba]

Вот как это выглядит в результате такой сортировки:


Но, есть одна проблема. Если данные из второй колонки оказываются не найденными среди данных первой колонки, то они просто теряются (такие пометил желтым) :


Нужно изменить макрос, чтобы не найденные данные выводились в четвертую колонку.

В результате должно получаться примерно так:



Заранее всем огромное спасибо!! !
[admin]
Тема закрыта. Причина: Нарушение правил пп. 2, 3, 5r[/admin]

Автор - anvvar
Дата добавления - 23.01.2014 в 17:01
AlexM Дата: Четверг, 23.01.2014, 17:23 | Сообщение № 2
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4517
Репутация: 1129 ±
Замечаний: 0% ±

Excel 2003
Все что вы показали картинками должно быть в прикрепленном файле.
Читайте правила форума.



Номер мобильного модема (без голосовой связи)
9269171249 МегаФон, Московский регион.
 
Ответить
СообщениеВсе что вы показали картинками должно быть в прикрепленном файле.
Читайте правила форума.

Автор - AlexM
Дата добавления - 23.01.2014 в 17:23
AndreTM Дата: Четверг, 23.01.2014, 17:46 | Сообщение № 3
Группа: Друзья
Ранг: Старожил
Сообщений: 1762
Репутация: 501 ±
Замечаний: 0% ±

2003 & 2010
Можно было и просто формулами найти...
А если макросом - можно как-то так:
[vba]
Код
Sub zz01()
     kA = Cells(Rows.Count, 1).End(xlUp).Row
     Set rA = Cells(1, 1).Resize(kA)
     kB = Cells(Rows.Count, 2).End(xlUp).Row
     Set rB = Cells(1, 2).Resize(kB)
     r = 1
     For Each c In rB.Cells
         Set f = rA.Find(c.Value, LookIn:=xlValues, LookAt:=xlWhole)
         If f Is Nothing Then
             Cells(r, 4) = c.Value
             r = r + 1
         Else
             Cells(1, 3).Offset(f.Row - 1) = c.Value
         End If
     Next
End Sub
[/vba]
К сообщению приложен файл: 2-8545-1-1.xls (27.5 Kb)


Skype: andre.tm.007
Donate: Qiwi: 9517375010
 
Ответить
СообщениеМожно было и просто формулами найти...
А если макросом - можно как-то так:
[vba]
Код
Sub zz01()
     kA = Cells(Rows.Count, 1).End(xlUp).Row
     Set rA = Cells(1, 1).Resize(kA)
     kB = Cells(Rows.Count, 2).End(xlUp).Row
     Set rB = Cells(1, 2).Resize(kB)
     r = 1
     For Each c In rB.Cells
         Set f = rA.Find(c.Value, LookIn:=xlValues, LookAt:=xlWhole)
         If f Is Nothing Then
             Cells(r, 4) = c.Value
             r = r + 1
         Else
             Cells(1, 3).Offset(f.Row - 1) = c.Value
         End If
     Next
End Sub
[/vba]

Автор - AndreTM
Дата добавления - 23.01.2014 в 17:46
anvvar Дата: Четверг, 23.01.2014, 18:30 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 60% ±

Excel 2010
AndreTM, Спасибо огромное! Макрос работает как нужно!
 
Ответить
СообщениеAndreTM, Спасибо огромное! Макрос работает как нужно!

Автор - anvvar
Дата добавления - 23.01.2014 в 18:30
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2025 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!