Убирание индексов согласно перечню с помощью макроса

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Убирание индексов согласно перечню с помощью макроса (Макросы/Sub)

Vselennaya

Дата: Понедельник, 09.07.2018, 15:29 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 18

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

Помогите сделать макрос для создания соседнего столбца без индексов.

К сообщению приложен файл: 8314700.xls (25.0 Kb)

Ответить

_Boroda_

Дата: Понедельник, 09.07.2018, 15:34 | Сообщение № 2

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16674

Репутация: 6479 ±

Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS

Может Вам простенькой формулой подойдет?

Код

=ПРОСМОТР(;-ПОИСК(D$2:D$7;A2);D$2:D$7)

К сообщению приложен файл: 8314700_1.xls (25.5 Kb)

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Ответить

Kuzmich

Дата: Понедельник, 09.07.2018, 19:52 | Сообщение № 3

Группа: Проверенные

Ранг: Ветеран

Сообщений: 711

Репутация: 156 ±

Замечаний: 0% ±

Excel 2003

Цитата

сделать макрос для создания соседнего столбца без индексов

[vba]

Код

Sub WithOutIndex()
Dim i As Long
Dim iLastRow As Long
Dim FoundCell As Range
Dim FAdr As String
   iLastRow = Cells(Rows.Count, 4).End(xlUp).Row
   For i = 2 To iLastRow
    Set FoundCell = Columns(1).Find(Cells(i, 4), , xlValues, xlPart)
     If Not FoundCell Is Nothing Then
        FAdr = FoundCell.Address
      Do
        FoundCell.Offset(, 1) = Cells(i, 4)
       Set FoundCell = Columns(1).FindNext(FoundCell)
      Loop While FoundCell.Address <> FAdr
     End If
   Next
End Sub

[/vba]