Вставить значения в соседние ячейки из др. книги в R[-3]C[5]

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Вставить значения в соседние ячейки из др. книги в R[-3]C[5] (Макросы/Sub)

timo64uk

Дата: Понедельник, 04.11.2024, 10:25 | Сообщение № 1

Группа: Пользователи

Ранг: Участник

Сообщений: 95

Репутация: 1 ±

Замечаний: 0% ±

Office16

Добрый день.

В активной книге, на активном листе, в столбце A (ниже ячеек, содержащих в столбце B слово "Согласовано") встречается несколько значений, которые нужно найти в закрытой книге 1111 (C:\Новая папка), лист 1111, столбец A эти же значения (в примере это одно 41ABA02AC02 из ячейки A12).
Дальше сложно: нужно от найденного значения "подняться" вверх по столбцу B и найти слово "заголовок 1" и вставить соседнее по строке значение столбца I в активную книгу в активный лист в -1 строку в +5 столбец от ячейки с первоначальным искомым значением (41ABA02AC02 из примера).
В примере ближайший заголовок вверх находится в ячейке B5, но он нам не нужен т.к. перед ним встречается слово "заголовок 2" - он то нам и нужен в данном случае и мы вставляем соседнее по строке значение столбца I
в активную книгу в активный лист в -2 строку в +5 столбец от ячейки с первоначальным-искомым значением.
И далее ищем в столбце В "заголовок 3" и значение из I вставляем в активный лист в -3 строку в +5 столбец от ячейки с первоначальным-искомым значением.
Т.е. ищем заголовок 1 - вставляем, если заголовок 2 или заголовок 3 не встречаются раньше (снизу вверх ближайший).
ищем заголовок 2 - вставляем, если заголовок 3 не встречаются раньше (снизу вверх ближайший).
ищем заголовок 3 - вставляем.
Пока писал что нужно сделать, то ловил себя на мысли, что это что-то фантастическое и на грани здравого смысла.

Добрый день.

К сообщению приложен файл: 1111.xlsx (9.9 Kb) · 2222.xlsx (12.6 Kb)

Ответить

СообщениеДобрый день.

Автор - timo64uk
Дата добавления - 04.11.2024 в 10:25

doober

Дата: Понедельник, 04.11.2024, 18:39 | Сообщение № 2

Группа: Друзья

Ранг: Ветеран

Сообщений: 970

Репутация: 332 ±

Замечаний: 0% ±

Excel 2010

крыша поехала.Как работает, не представляю.Заточите под себя[vba]

Код

Sub Test()
    Dim oConn As Object, Sh As Worksheet, Rng As Range
    Dim objRS As Object, IsZag1 As Boolean, IsZag2 As Boolean, IsZag3 As Boolean
    Dim sPath, avr
    Set Sh = ActiveSheet
    Set Rng = Sh.Range("A6")
    Art$ = Rng
    sPath = "C:\Users\Сергей\Downloads\1111.xlsx"    'Указывайте свой путь
    Set oConn = CreateObject("ADODB.Connection")
    oConn.CursorLocation = 3
    oConn.Open "DBQ=" & sPath & ";Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)}"
    sSql = "SELECT * FROM [1111$]"
    Set objRS = oConn.Execute(sSql)
    li = objRS.RecordCount
    avr = objRS.getrows
    ReDim res(1 To li + 1, 1 To UBound(avr) + 1)
    For n = 0 To UBound(avr)
        res(1, n + 1) = objRS.Fields(n).Name
    Next

    For n = 0 To UBound(avr, 2)
        For i = 0 To UBound(avr)
            If Not IsNull(avr(i, n)) Then
                res(n + 2, i + 1) = avr(i, n)
            End If
        Next
    Next
    IsZag1 = False
    IsZag2 = False
    IsZag3 = False

    For n = 1 To UBound(res)
        Key$ = res(n, 1)
        If Key = Art Then
            For j = n - 1 To 1 Step -1
                заголовок = res(j, 2)
                Select Case заголовок
                Case "заголовок 1"
                    If IsZag1 = False Then
                        Rng.Offset(-1, 5) = res(j, 9)
                        IsZag1 = True
                    End If
                Case "заголовок 2"
                    IsZag1 = True
                    If IsZag2 = False Then
                        Rng.Offset(-2, 5) = res(j, 9)
                        IsZag2 = True
                    End If
                Case "заголовок 3"
                    IsZag1 = True
                    IsZag2 = True
                    If IsZag3 = False Then
                        Rng.Offset(-3, 5) = res(j, 9)
                        IsZag3 = True
                    End If
                End Select
            Next
        End If
    Next
End Sub

[/vba]

крыша поехала.Как работает, не представляю.Заточите под себя[vba]

Код

[/vba]doober

Ответить

Сообщениекрыша поехала.Как работает, не представляю.Заточите под себя[vba]

Код

[/vba]

Автор - doober
Дата добавления - 04.11.2024 в 18:39

timo64uk

Дата: Вторник, 05.11.2024, 02:22 | Сообщение № 3

Группа: Пользователи

Ранг: Участник

Сообщений: 95

Репутация: 1 ±

Замечаний: 0% ±

Office16

Цитата doober, 04.11.2024 в 18:39, в сообщении № 2 (

)

работает

Спасибо огромное. Я примерно представлял количество условий IF, но не думал, что это вообще реально. Фантастика.
***
Вы просто красавчик. Оно работает. Это действительно волшебство. Спасибо

Сообщение отредактировал timo64uk - Вторник, 05.11.2024, 02:43

Ответить

timo64uk

Дата: Вторник, 05.11.2024, 03:24 | Сообщение № 4

Группа: Пользователи

Ранг: Участник

Сообщений: 95

Репутация: 1 ±

Замечаний: 0% ±

Office16

Цитата timo64uk, 05.11.2024 в 02:22, в сообщении № 3 (

)

[vba]

Код

Set Rng = Sh.Range("A6")

[/vba]

Подскажите, пожалуйста, что нужно еще изменить, чтобы расширить область нахождения исходных значений? [vba]

Код

LastRow = Sh.Cells(Sh.Rows.Count, "A").End(xlUp).Row
Set Rng = Sh.Range("A6:A"& LastRow)

[/vba]

Сообщение отредактировал timo64uk - Вторник, 05.11.2024, 04:01

Ответить

doober

Дата: Вторник, 05.11.2024, 16:30 | Сообщение № 5

Группа: Друзья

Ранг: Ветеран

Сообщений: 970

Репутация: 332 ±

Замечаний: 0% ±

Excel 2010

Примерно так.[vba]

Код

Sub Test()
    Dim oConn As Object, Sh As Worksheet, Rng As Range
    Dim objRS As Object, IsZag1 As Boolean, IsZag2 As Boolean, IsZag3 As Boolean
    Dim sPath, avr, cel As Range
    Set Sh = ActiveSheet
    LastRow = Sh.Cells(Sh.Rows.Count, "A").End(xlUp).Row
    Set Rng = Sh.Range("A6:A" & LastRow)
    sPath = "C:\Users\Сергей\Downloads\1111.xlsx"    'Указывайте свой путь
    Set oConn = CreateObject("ADODB.Connection")
    oConn.CursorLocation = 3
    oConn.Open "DBQ=" & sPath & ";Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)}"
    sSql = "SELECT * FROM [1111$]"
    Set objRS = oConn.Execute(sSql)
    li = objRS.RecordCount
    avr = objRS.getrows
    ReDim res(1 To li + 1, 1 To UBound(avr) + 1)
    For n = 0 To UBound(avr)
        res(1, n + 1) = objRS.Fields(n).Name
    Next

    For n = 0 To UBound(avr, 2)
        For i = 0 To UBound(avr)
            If Not IsNull(avr(i, n)) Then
                res(n + 2, i + 1) = avr(i, n)
            End If
        Next
    Next
    For Each cel In Rng
        Art$ = cel
        IsZag1 = False
        IsZag2 = False
        IsZag3 = False

        For n = 1 To UBound(res)
            Key$ = res(n, 1)
            If Key = Art Then
                For j = n - 1 To 1 Step -1
                    заголовок = res(j, 2)
                    Select Case заголовок
                    Case "заголовок 1"
                        If IsZag1 = False Then
                            cel.Offset(-1, 5) = res(j, 9)
                            IsZag1 = True
                        End If
                    Case "заголовок 2"
                        IsZag1 = True
                        If IsZag2 = False Then
                            cel.Offset(-2, 5) = res(j, 9)
                            IsZag2 = True
                        End If
                    Case "заголовок 3"
                        IsZag1 = True
                        IsZag2 = True
                        If IsZag3 = False Then
                            cel.Offset(-3, 5) = res(j, 9)
                            IsZag3 = True
                        End If
                    End Select
                Next
            End If
        Next
    Next

End Sub

[/vba]

Примерно так.[vba]

Код