Обработать столбец значений..

[wowa]

Подскажите начинающему...
В столбце "А" есть n-ое число значений, допустим:

ааа
ббб
ввв::ггг
ддд
еее
жжж::ззз

Дак вот, если в значении встречается символ "::", то необходимо разбить значение, ну вообщем чтобы в итоге вышло:

ааа
ббб
ввв
ггг
ддд
еее
жжж
ззз

Подскажите, пожалуйста, как это сделать..

 

[Tanya]

Sub nnnn()
Dim i As Integer
Dim j As Integer
Dim iStart As Integer

With ActiveSheet
iStart = .UsedRange.Row
i = iStart
Do While i < .UsedRange.Rows.Count + iStart - 1
j = InStr(1, .Cells(i, 1).Value, "::")
If j > 0 Then
.Cells(i + 1, 1).Insert xlShiftDown
.Cells(i + 1, 1).Value = Mid$(.Cells(i, 1).Value, j + 2)
.Cells(i, 1).Value = Left$(.Cells(i, 1).Value, j - 1)
i = i + 1
End If

i = i + 1
Loop
End With
End Sub

вот как-то приблизительно так

 

[wowa]

Tanya , Большое спасибо, +1

 

[wowa]

Tanya , есть вариант , когда в одной ячейке может быть значение:
"ааа::ббб::ввв"
Тогда в данном случае код не правильно отработает,
внутрь if встатить бы какой-н цикл... ну , сделать из этого значения массив и дальше все просто
Вот только я не нахожу метод для создания массива из строки с разделителем

 

[Tanya]

И так можно )))

Sub nnnn()
Dim i As Integer
Dim j As Integer
Dim iStart As Integer
Dim arr() As String

With ActiveSheet
iStart = .UsedRange.Row
i = iStart
Do While i < .UsedRange.Rows.Count + iStart - 1
arr = Split(.Cells(i, 1).Value, "::")
If UBound(arr) > LBound(arr) Then
.Cells(i, 1).Value = arr(0)
For j = 1 To UBound(arr)
i = i + 1
.Cells(i, 1).Insert xlShiftDown
.Cells(i, 1).Value = arr(j)
Next j
End If
i = i + 1
Loop
End With
End Sub

 

[wowa]

Tanya , Спасибо
Подскажите, пожалуйста, еще такой момент, вот допустим такой код:

.Cells(i, 1).Value = arr(0)

Допустим arr(0) = "ввв"
На какой-то странице, например, страница называется "Страница№1", в ячейке A1 занесено это значение "ввв", а напротив в B1 - значение "ВВВ"
Дак вот, как с помощью кода сразу занести в Cells(i, 1) не "ввв", а "ВВВ".
В самом экселе есть такая функция "VLookup", а как программно? Может как-н с пом. replace ..
Надеюсь я понятно изложил свою проблему ((

 

[Tanya]

Если я все правильно поняла, то есть несколько вариантов решения такой задачи
я предложу возможно не самый удачный (по-быстрому))))
Он основан на использовании формулы поиска значения и проверки значения на ошибку

VLOOKUP(...) - поиск, FALSE - указывает, что если в искомом списке нет искомого значения, то возвращаем ошибку
ISNA(...) - проверка на ошибку Н/Д
IF(...) условие, если вернет ошибку, то возвращаем пустое значение, иначе возвращаем найденное значение

Sub nnnn()
Const STR_FORMULA As String = "=IF(ISNA(VLOOKUP(RC[-1],Лист1!C1:C2,2,FALSE)),"""",VLOOKUP(RC[-1],Лист1!C1:C2,2,FALSE))"
Dim i As Integer
Dim j As Integer
Dim iStart As Integer
Dim arr() As String

With ActiveSheet
iStart = .UsedRange.Row
i = iStart
Do While i < .UsedRange.Rows.Count + iStart - 1
If Len(.Cells(i, 1).Value) Then
arr = Split(.Cells(i, 1).Value, "::")
.Cells(i, 2).Value = STR_FORMULA	'то есть тупо вставляем формулу в столбец рядом

If UBound(arr) > LBound(arr) Then
.Cells(i, 1).Value = arr(0)

For j = 1 To UBound(arr)
i = i + 1
.Cells(i, 1).Insert xlShiftDown
.Cells(i, 1).Value = arr(j)
.Cells(i, 2).Value = STR_FORMULA
Next j
End If
End If
i = i + 1
Loop
End With
End Sub

Чем плох этот метод? Как минимум
1) Не факт что будет правильно работать с неотсортированной таблицей, по которой идет поиск
2) Могут быть варианты с написанием формул: русский / английский
3) Возникают проблемы, если нам нужно вставлять найденные значения в исходный столбец

Что еще можно использовать?
I) вместо написания формулы в виде строки вставлять уже готовое значение вызовом экселевских функций, например

 .Cells(i, 2).Value = application.WorksheetFunction.VLookup(...)

это избавит от вариаций с языком рус/англ и значения можно подставлять в любой столбец, в т.ч. и исходный

II) написать свою функцию поиска

Удачи! Я надеюсь я не очень сумбурно описала варианты и правильно поняла вопрос :blink:

 

[wowa]

Что-то у меня не получается впихнуть в application.WorksheetFunction.VLookup(...) код, ошибки...
В Екселе формула такая:
=VLOOKUP('страница1'!F6;Отчет.xls!www;2;0)

 

[Tanya]

Не получается, потому что нужно обработку ошибок добавлять
Да и в функцию подставляем диапазоны! (range), а не текст

Application.WorksheetFunction.VLookup(.Cells(i, 1), Sheets(1).Range("A:B"), 2, False)

В ближайшее время я не смогу сориентировать больше
поэтому попробуй разобрать в этом коде:

Sub nnnn()
Dim i As Integer
Dim j As Integer
Dim iStart As Integer
Dim arr() As String

'Отключаем получение ошибки при вызове функции DLookup()
On Error Resume Next

'Sheets(1).Range("A:B") - таблица в которой ищем
With ActiveSheet
iStart = .UsedRange.Row
i = iStart
Do While i < .UsedRange.Rows.Count + iStart - 1
If Len(.Cells(i, 1).Value) Then
arr = Split(.Cells(i, 1).Value, "::")

If UBound(arr) > LBound(arr) Then
.Cells(i, 1).Value = arr(0)

For j = 1 To UBound(arr)
i = i + 1
.Cells(i, 1).Insert xlShiftDown
.Cells(i, 1).Value = arr(j)

.Cells(i, 2).Value = Application.WorksheetFunction.VLookup(.Cells(i, 1), Sheets(1).Range("A:B"), 2, False)
If j = 1 Then .Cells(i - 1, 2).Value = Application.WorksheetFunction.VLookup(.Cells(i - 1, 1), Sheets(1).Range("A:B"), 2, False)

If Err Then Err.Clear 'очищаем если была ошибка
Next j
Else
.Cells(i, 2).Value = Application.WorksheetFunction.VLookup(.Cells(i, 1), Sheets(1).Range("A:B"), 2, False)
If Err Then Err.Clear 'очищаем если была ошибка
End If
End If
i = i + 1
Loop
End With
End Sub

 

[wowa]

Tanya , хотел спросить еще вот по этой формуле:

Application.WorksheetFunction.VLookup(.Cells(i, 1), Sheets(1).Range("A:B"), 2, False)

Можно ли с помощью ее решить такую задачу.. Мне нужно в зависимости от .Cells(i, 1) и .Cells(i, 2) вывести значение третьего столбика.. ???

 

[Tanya]

если имеется ввиду, что в таблице поиска по двум колонкам выбрать значение в третьей колонке,
то нет, нужно программировать самому
все дело в параметрах: второй параметр - таблица в которой идет поиск, значения первого параметра
поиск всегда идет по первому столбцу

 

[wowa]

Tanya , да именно так мне и надо сделать..
Может подскажите какими тут можно методами воспользоваться , алгоритмом или еще чем-н...

 

[wowa]

Ну у меня есть предположение:
Получить нужную таблицу, и делать следующее
if a(i)="значение_1" и b(i)="значение_2" then получить с(i)
else i++
и так зациклить пока не получу нужное c(i)
Но так будет очень медленно все работать, т.к. нужно будет пройти цикл более 200 раз, да и сам цикл будет очень медленно работать

 

[Tanya]

насколько я знаю, цикл в 200 итераций не будет работать долго

 

[Tanya]

Function Search(tbl As Range, col As Integer, ParamArray p() As Variant) As Variant
'tbl - диапазон, содержащий таблицу поиска
'col - номер колонки с требуемыми данными в таблице поиска
'p - массив значений, по которым ведется поиск

Dim i As Long, j As Integer
Dim bln As Boolean
Dim cols As Integer

'проверки соответствия количества колонок
cols = UBound(p) + 1
If tbl.Columns.Count - 1 < cols Then
cols = tbl.Columns.Count - 1
End If

If col > tbl.Columns.Count Then Exit Function

'поиск по каждой строке
For i = 1 To tbl.Rows.Count
bln = True

'считаем, что первая встреченная пустая ячейка в первой колонке - это окончание данных в таблице
If Len(tbl.Cells(i, 1).Value) = 0 Then Exit For

'проверка по колонкам
For j = LBound(p) To cols - 1
If tbl.Cells(i, j + tbl.Column) <> p(j) Then
'нашли несовпадение - уходим из этого цикла
bln = False
Exit For
End If
Next j

If bln Then
'все совпало - получаем требуемое значение и выходим из функции
Search = tbl.Cells(i, col)
Exit Function
End If
Next i

'ничего не нашли, возвращаем пустую строку
Search = ""

End Function

Sub test()
'в примере на листе 3 в колонках A:C листа 3 расположена таблица поиска
'требуется по значениям ячеек A6 и B6 листа 2 получить значение из таблицы поиска
'значения расположены в третьей колонке таблицы поиска

MsgBox Search(Sheets(3).Range("A:C"), 3, Sheets(2).Range("A6").Value, Sheets(2).Range("B6").Value)
End Sub

Функция Search может использоваться как формула, например выполнение того же поиска, что и в test:
=Search(Лист3!A:C;3;A6;B6)

Количество ключей может быть и 1, и 2, и 3 и т.д. )))