2015-12-18 7 views
1

Я работаю над небольшим проектом. Я столкнулся с проблемой, которую я не могу обойти. Любая помощь будет высоко оценен. У меня есть следующие листы: Sheet1 Sheet2Извлечение нескольких номеров из одной строки строки для просмотра результатов

Мне нужна функция, которая извлекает эти 3 цифры из Лист1 (может быть больше или меньше 3), они всегда ограниченные «()» и искать значения в Sheet2 на основе цифр в столбце A1.

Я был в состоянии написать следующий код (с помощью this question) для извлечения цифр, но я не знаю, как изолировать фигуры из одной клетки и посмотреть на его основе в sheet2:

Edit:

Я думал, что справимся с остальными, но я ошибся. Я был бы признателен за дополнительную помощь в расширении кода, чтобы вернуть столбец B из Sheet2. Как правило, логика заключается в том, что функция разбивает ячейку из листа 1, а затем каждый элемент просматривается в Листе2. Конечный результат этой функции будет:

Test1 Test2 Test3

Я обновил код, что я пробовал себя.

Function onlyDigits(s As String) As String 
Dim retval As String 
Dim i,j As Integer 
Dim TestRng as Range 
Dim NoArr() as String 
Dim TestRes() as String 

retval = "" 
s = Replace(s, ")", " ") 
For i = 1 To Len(s) 
    If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" Or Mid(s, i, 1) = " " Then 
     retval = retval + Mid(s, i, 1) 
    End If 
Next 
'deletes last unnecessary space 
retval = Left(retval, Len(retval) - 1) 
'array with results after extracting numbers 
NoArr() = Split(retval, " ", , vbTextCompare) 
'vlookedup range 
set TestRng = Worksheets("Sheet2").Range("A1:B3") 

For j = LBound(NoArr) To UBound(NoArr) 

    TestRes(j) = Application.WorksheetFunction.VLookup(NoArr(j), TestRng, 2, 0) 

Next j 

onlyDigits = TestRes 
End Function 

ответ

0

Сохраняясь своим текущим методом, я изменил вашу функцию, чтобы вернуть нужное вам значение, передав место держателю места. Я изменил первую и вторую на последние строки.

Function onlyDigits(s As String, pos As Integer) As String 
    Dim retval As String 
    Dim i As Integer 

    retval = "" 
    s = Replace(s, ")", " ") 
    For i = 1 To Len(s) 
     If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" Or Mid(s, i, 1) = " " Then 
      retval = retval + Mid(s, i, 1) 
     End If 
    Next 
    'deletes last unnecessary space 
    retval = Left(retval, Len(retval) - 1) 
    onlyDigits = Split(retval, " ", , vbTextCompare)(pos) 
End Function 

Для того, чтобы позвонить в ячейке записи: =onlyDigits(A1,0) нулевая позиция для возврата

Пример enter image description here

Колонка E показывает уравнение, используемый в колонке D

+0

Большое спасибо, вот что я искал – Raqu

+0

Я думал, что справимся с остальными сам, но я не добился успеха. Я обновил свой вопрос. Как правило, логика заключается в том, что функция разбивает ячейку из листа 1, а затем каждый элемент просматривается в Sheet2. Конечным результатом этой функции будет: Test1 Test2 Test3 – Raqu

0

ОК I решил мою проблему со следующим кодом:

F Function onlyDigits(s As String) As String 
Dim retval As String 
Dim i, j As Integer 
Dim TestRng As Range 
Dim NoArr() As String 
Dim TestRes() As String 

retval = "" 
s = Replace(s, ")", " ") 
For i = 1 To Len(s) 
    If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" Or Mid(s, i, 1) = " " Then 
     retval = retval + Mid(s, i, 1) 
    End If 
Next 
'deletes last unnecessary space 
retval = Left(retval, Len(retval) - 1) 
'array with results after extracting numbers 
NoArr() = Split(retval, " ", , vbTextCompare) 
'vlookedup range 
Set TestRng = Worksheets("Sheet2").Range("A1:B3") 

For j = LBound(NoArr) To UBound(NoArr) 
    ReDim Preserve TestRes(j) 
    TestRes(j) = Application.WorksheetFunction.VLookup(CLng(NoArr(j)), TestRng, 2, False) 

Next j 

onlyDigits = Join(TestRes, vbNewLine) 
End Function 
Смежные вопросы