Помогите написать макрос или составить формулу для выбора ячеек, связанных общими элементами и составить их цепочку в отдельной ячейке

[Serge_Bliznykov]

Сообщение от tor45

как-то так. извиняюсь за костноязычность объяснения алгоритма. может моя блок-схема громмоздка и можно всё сделать как-то оптимальнее.

да нет, это нормальное описание и алгоритм годный вполне.
если бы я писал макрос, то такой же примерно алгоритм и воплощал.

Сообщение от tor45

просто есть таблицы excel с очень большим количеством оборудования. переделывать всю эту информацию в access - праздник труда.

Вам на месте, конечно, виднее.
Тут больше проблема, что дальше делать - вести учёт в Excel или в БД.
если в БД, то выгрузить данные и потом "засосать" в любую БД - это не так сложно, как кажется.
и от количества файлов и строк в файле не зависит. Если сделаете автоматическую выгрузку и импорт небольшой таблицы из вашего примера, то никто не помешает сделать тоже самое для сотен тысяч строк и сотен файлов.

Но, как я понимаю, о переводе данных в БД речи не идёт, Вы остановились на макросе в Excel, верно?

[tor45]

верно. думаю в данной ситуации проще обойтись макросом для excel

[Aleksandr H.]

если идем строго внизу-вверх. Вариант как база

Option Explicit
Dim startRow As Integer
Sub Work()
    Dim C As String
    Dim D As String
    Dim B As String
    Dim Lvl As Byte
    [G10] = [C27]: [h10] = [d27]
    C = [G10]
    D = [h10]
    Dim rCount As Integer
    startRow = -1
    rCount = Cells(Rows.Count, "B").End(xlUp).Row
    Do While rCount > 0 And startRow = -1
        If Cells(rCount, "C") = C And Cells(rCount, "D") = D Then startRow = rCount
        rCount = rCount - 1
    Loop
    If startRow = -1 Then Exit Sub
    B = Cells(startRow, "B")
    Lvl = 1
    Do While Left(B, 3) <> "MXG"
        B = Cells(startRow, "B")
        [h10].Offset(, Lvl) = GetChain(startRow)
        Lvl = Lvl + 1
    Loop
End Sub

Function GetChain(ByRef start As Integer)
    Dim chainText As String
    Dim tmp As String
    chainText = Cells(start, "B")
    
    Do While Cells(start, "A") = "" And start >= 0
        start = start - 1
    Loop
    
    If Left(chainText, 3) = "MXG" Then
        GetChain = Cells(start, "A") & " " & chainText
    Else
    
    tmp = Cells(start, "A")
    Do While Cells(start, "C") <> tmp And start >= 0
        start = start - 1
    Loop
    GetChain = Cells(start, "C") & " " & Cells(start, "D") & " " & chainText
End If
End Function

[tor45]

спасибо большое! поразбираюсь попробую сам теперь))