Помощь - Поиск - Пользователи - Календарь
Полная версия этой страницы: Обработать столбец значений..
Форум программистов > Системное программирование > Visual Basic
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) написать свою функцию поиска

Удачи! Я надеюсь я не очень сумбурно описала варианты и правильно поняла вопрос smile.gif
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 и т.д. )))
Для просмотра полной версии этой страницы, пожалуйста, пройдите по ссылке.
Форум IP.Board © 2001-2008 IPS, Inc.