Разделить ячейку по критериям

Question

У меня сложное разделение, которое мне нужно сделать в VBA Excel. Я хочу разделить каждый кусок, который начинается с «C:», включает в себя «OCAK» и заканчивается «.JPG» в диапазоне («C1») на A1, A2, A3 ... при нажатии кнопки.

ОТ ЭТОГО

ДО ЭТОГО

Я все еще занимаюсь исследованиями и тестированием, но не могу найтиреальное жизнеспособное решение. Любые идеи будут с благодарностью.

Private Sub buton_Click()

If Cells(1, "c").Text Like "C:*OCAK*.jpg*" Then
   Dim jpgStart As Long
   jpgStart = InStr(Cells(1, "c").Text, ".jpg")
   Dim result As String
   result = Left(Cells(1, "c").Text, jpgStart - 1)
   Cells(1, "c").Offset(0, -2).Value = result
Else
   Cells(1, "c").Offset(0, -2).Value = vbNullString
End If
End Sub

Answer 1

Проблема на самом деле в расщеплении. Во входных данных новая строка также должна использоваться в качестве разделителя. Таким образом, рассмотрите возможность изменения входного значения на что-то вроде этого:

readCell = Worksheets(1).Cells(1, "C")

readCell = Replace(readCell, Chr(13) & Chr(10), " ")
readCell = Replace(readCell, vbCrLf, " ")
readCell = Replace(readCell, vbNewLine, " ")
readCell = Replace(readCell, vbLf, " ")

После того, как вход зафиксирован, из единиц можно построить массив - myArray = Split(readCell). Циклическая обработка массива и использование Like "C:*OCAK*.jpg" работает довольно хорошо:

Public Sub TestMe()

    Dim readCell As String
    readCell = Worksheets(1).Cells(1, "C")

    readCell = Replace(readCell, Chr(13) & Chr(10), " ")
    readCell = Replace(readCell, vbCrLf, " ")
    readCell = Replace(readCell, vbNewLine, " ")
    readCell = Replace(readCell, vbLf, " ")

    Dim myArray As Variant
    myArray = Split(readCell)

    Dim myVar As Variant
    Dim currentRow As Long: currentRow = 1

    For Each myVar In myArray
        If myVar Like "C:*OCAK*.jpg" Then
            Worksheets(1).Cells(currentRow, "A") = myVar
            currentRow = currentRow + 1
        End If
    Next

End Sub

Answer 2

• Разделить на vbLf

• Разделить пробелом

• Проверка на результат

Код:

Option Explicit
Sub GetOcak()

    Dim arr As Variant

    arr = Split(Cells(1, 3).Value, vbLf)

    Dim i As Long
    Dim j As Long

    j = 1

    For i = 0 To UBound(arr)
        If Left(Split(arr(i), " ")(0), 7) = "C:\OCAK" And _
           Right(Split(arr(i), " ")(0), 4) = ".jpg" Then
            Cells(j, 1).Value = Split(arr(i), " ")(0)
            j = j + 1
        End If
    Next i

End Sub

Answer 3

В коде макроса вашей кнопки зациклите ячейки в столбце c;Я должен предположить, что вы знаете, как это настроить и сделать это. Тогда для каждого cell в этом диапазоне:

with thisworkbook.worksheets("theNameOfYourSheet")
   dim loopRange As Range
   set loopRange=.Range(.Cells(1,3),.Cells(.UsedRange.Rows.Count,3))
end with
dim cell as Range

for each cell in loopRange
    If cell.text Like "C:*.jpg*" Then
       Dim jpgStart As Long
       jpgStart = Instr(cell.text,".jpg")
       Dim result As String
       result= Left(cell.text,jpgStart-1)
       cell.offset(0,-1).Value=result
    Else
       cell.offset(0,-1).Value = vbNullString
    End If
Next