Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Извлечение чисел из текста по определенному слову VBA, Поиск значений с последующей вставкой формул
 
#1
13.02.2024 12:00:40
Добрый день, уважаемые знатоки. Помогите ,пожалуйста. Есть таблицы ,в которых одними из строчек являются масса и объем. Задача: Вынести в колонки L и M только значения объема и массы. Проблема: Масса и объем выносятся только в первой табличке, а на последующие(на текущем листе) макрос не распространяется. Как сделать так, чтобы макрос искал ключевые слова и выносил значения из ячеек по всему листу?



Sub Макрос1()
Dim rFoundRng As Range
   Dim sTSearch As String
   Dim qFoundRng As Range
   Dim sTS As String
   sTSearch = "Объем"
   k_ = _
       "=LOOKUP(2^64,--LEFT(MID(RC[-11]&0,MIN(FIND({0,1,2,3,4,5,6,7,8,9},RC[-11]&123456789)),15),{1,2,3,4,5,6,7,8,9,10,11,12,13,14,15}))"
   Set rFoundRng = Rows.Find(sTSearch, , xlFormulas, xlPart)
   r_ = rFoundRng.Row
   If Not rFoundRng Is Nothing Then
       Range("L" & r_) = k_
   Else
       MsgBox "Ничего нет"
       Exit Sub
   End If
   sTS = "Масса"
   s_ = _
       "=LOOKUP(2^64,--LEFT(MID(R[1]C[-12]&""_0"",MIN(FIND({0,1,2,3,4,5,6,7,8,9},R[1]C[-12]&""_0123456789"")),15), {1,2,3,4,5,6,7,8,9,10,11,12,13,14,15}))"
   Set qFoundRng = Rows.Find(sTS, , xlFormulas, xlPart)
   q_ = qFoundRng.Row
   If Not rFoundRng Is Nothing Then
       Range("M" & q_ - 1) = s_
   Else
       MsgBox "Ничего нет"
       Exit Sub
   End If
End Sub
 
 
 
#2
13.02.2024 13:00:03
bodhiking, добрый день!

Вам же уже дали приемлемое решение с формулой в соседней вашей теме?
Зачем вы хотите посредством VBA копировать формулу?

По вашему коду: при поиске вызывают сначала .Find, запоминают первый найденный адрес, затем в цикле выполняют действия с найденным, а далее вызывают .FindNext, проверяя, не нашли ли снова первый адрес - тогда выход из цикла.
Код
With Worksheets(1).Range("a1:a500")
    Set c = .Find(2, lookin:=xlValues) 
    If Not c Is Nothing Then 
        firstAddress = c.Address 
        Do 
            c.Value = 5 
            Set c = .FindNext(c) 
        Loop While Not c Is Nothing And c.Address <> firstAddress 
    End If 
End With
Изменено: andypetr - 13.02.2024 13:04:16
 
 
 
#3
13.02.2024 13:09:20
Так?
Код
Sub VynosMozga()
Dim iCl As Range
With Worksheets("RDBMergeSheet")
  For Each iCl In .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).Cells
    If iCl Like "Объем*" Then
      iCl.Offset(, 4) = Split(iCl, " ")(1)
      iCl.Offset(, 5) = Split(iCl.Offset(1), " ")(1) * 1
    End If
  Next
End With
End Sub
Согласие есть продукт при полном непротивлении сторон
 
 
 
#4
13.02.2024 13:30:39
Знаете, я не занимался никогда никаким языком программирования и меня искренне поражает как вы можете спокойно написать код, который я пытаюсь написать в течение месяца. Благодарю за помощь и хорошее чувство юмора)
 
 
 
Страницы: 1
Наверх