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

Тема в разделе "Visual Basic", создана пользователем wowa, 15 сен 2008.

  1. wowa

    wowa Well-Known Member

    Регистрация:
    1 фев 2007
    Сообщения:
    842
    Симпатии:
    0
    Подскажите начинающему...
    В столбце "А" есть n-ое число значений, допустим:
    Код (Text):
    ааа
    ббб
    ввв::ггг
    ддд
    еее
    жжж::ззз
    Дак вот, если в значении встречается символ "::", то необходимо разбить значение, ну вообщем чтобы в итоге вышло:
    Код (Text):
    ааа
    ббб
    ввв
    ггг
    ддд
    еее
    жжж
    ззз

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

    Tanya Гость

    Код (Text):
    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
    вот как-то приблизительно так
     
  3. wowa

    wowa Well-Known Member

    Регистрация:
    1 фев 2007
    Сообщения:
    842
    Симпатии:
    0
    Tanya , Большое спасибо, +1
     
  4. wowa

    wowa Well-Known Member

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

    Tanya Гость

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

    Код (Text):
    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
     
  6. wowa

    wowa Well-Known Member

    Регистрация:
    1 фев 2007
    Сообщения:
    842
    Симпатии:
    0
    Tanya , Спасибо
    Подскажите, пожалуйста, еще такой момент, вот допустим такой код:

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

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

    Tanya Гость

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

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

    Код (Text):
    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) вместо написания формулы в виде строки вставлять уже готовое значение вызовом экселевских функций, например
    Код (Text):
     .Cells(i, 2).Value = application.WorksheetFunction.VLookup(...)
    это избавит от вариаций с языком рус/англ и значения можно подставлять в любой столбец, в т.ч. и исходный

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

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

    wowa Well-Known Member

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

    Tanya Гость

    Не получается, потому что нужно обработку ошибок добавлять
    Да и в функцию подставляем диапазоны! (range), а не текст
    Код (Text):
    Application.WorksheetFunction.VLookup(.Cells(i, 1), Sheets(1).Range("A:B"), 2, False)
    В ближайшее время я не смогу сориентировать больше
    поэтому попробуй разобрать в этом коде:

    Код (Text):
    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
     
  10. wowa

    wowa Well-Known Member

    Регистрация:
    1 фев 2007
    Сообщения:
    842
    Симпатии:
    0
    Tanya , хотел спросить еще вот по этой формуле:

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

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

    Tanya Гость

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

    wowa Well-Known Member

    Регистрация:
    1 фев 2007
    Сообщения:
    842
    Симпатии:
    0
    Tanya , да именно так мне и надо сделать..
    Может подскажите какими тут можно методами воспользоваться , алгоритмом или еще чем-н...
     
  13. wowa

    wowa Well-Known Member

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

    Tanya Гость

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

    Tanya Гость

    Код (Text):
    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 и т.д. )))
     
Загрузка...

Поделиться этой страницей