Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Создание цикла поиска информации в ячейках и запуске готовой функции
 
#1
27.03.2017 16:03:15
Добрый день. Помогите пожалуйста, не получается добавить цикл.
Циклом проверяем вниз строчки, например с 4 по 20.  Проверяем наличие в них информации, если  находим данные в строке, то запускаем функцию. Переработанные  данные нужно записать в ячейку, например в К4
Код
Txt = LCase(Cells(1, 1))
Txt = Replace(Txt, ", , ", "")
Txt = Replace(Txt, ", , ,", "")
Txt = Replace(Txt, ", ,", ",")
Txt = Replace(Txt, ",", ", ")

Dim Str() As String
Str = Split(Txt, " ")
Txt = ""
For Each s In Str
    L = Left(s, 1)
    If Txt = "" Then
        Txt = Replace(s, L, UCase(L), 1, 1)
    Else
        Txt = Txt & " " & Replace(s, L, UCase(L), 1, 1)
    End If
Next

For i = Len(Txt) To 1 Step -1
    If Mid(Txt, i, 1) Like "[0-9]" Or Mid(Txt, i, 1) = "-" Then
        L = Mid(Txt, i + 1, 1)
        a = Mid(Txt, 1, i)
        b = Replace(Txt, L, UCase(L), i + 1, 1)
        Txt = a & b
    End If
Next i
Cells(2, 1) = Txt
End Sub
 
 
 
#2
27.03.2017 16:15:17
Добрый день. А можете простыми словами описать, что вы хотите от процедуры добиться? Для четко определенного количества строк нужно решение? Или, может быть, для произвольно заданного количества (через выделение, например)? Всегда ли надо в К4 записывать данные переработанные, или надо записывать, например "отступив на 2 столбца вправо от обрабатываемого столбца"?
Кому решение нужно - тот пример и рисует.
 
 
 
#3
27.03.2017 16:37:02
Написал Вам в файле
 
 
 
#4
27.03.2017 16:42:09
так?
 
 
 
#5
27.03.2017 19:42:17
Или так
Код
Private Sub btn1_Click()
Dim arrVal()
Dim I&, J&, Txt$
arrVal = Range("A4:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value
For I = 1 To UBound(arrVal)
    Txt = Replace(Replace(Replace(Replace(StrConv(Replace(Replace(Replace(Replace(LCase(arrVal(I, 1)), ", , ", ""), ", , ,", ""), ", ,", ","), ",", ", "), vbProperCase), "Город", "г."), "Улица", "ул."), "Литера", "лит."), "Помещение", "пом.")
    For J = Len(Txt) To 1 Step -1
        If Mid(Txt, J, 1) Like "[0-9]" Or Mid(Txt, J, 1) = "-" Then
            arrVal(I, 1) = Mid(Txt, 1, J) & Replace(Txt, Mid(Txt, J + 1, 1), UCase(Mid(Txt, J + 1, 1)), J + 1, 1)
        End If
    Next
Next
Range("K4").Resize(UBound(arrVal, 1), UBound(arrVal, 2)) = arrVal
End Sub
Смысл второго цикла (For J = Len(Txt) To 1 Step -1...Next) не совсем понял, а то можно и от него отказаться, наверное
Согласие есть продукт при полном непротивлении сторон
 
 
 
#6
28.03.2017 10:50:34
[USER=917]Sanja[/USER, можно пожалуйста добавить описание, пометки
 
 
 
Страницы: 1
Наверх