Версия для слабовидящих
Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

 

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

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Вставить значения в соседние ячейки из др. книги в R[-3]C[5]
timo64uk Дата: Понедельник, 04.11.2024, 10:25 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 121
Репутация: 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)
 
Ответить
СообщениеДобрый день. :)
В активной книге, на активном листе, в столбце 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 - вставляем.
Пока писал что нужно сделать, то ловил себя на мысли, что это что-то фантастическое и на грани здравого смысла.

Автор - timo64uk
Дата добавления - 04.11.2024 в 10:25
doober Дата: Понедельник, 04.11.2024, 18:39 | Сообщение № 2
Группа: Друзья
Ранг: Ветеран
Сообщений: 983
Репутация: 340 ±
Замечаний: 0% ±

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

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]
Sub Тest()    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 = "ВЫДЕЛИТЬ * 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 IsЧull(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 = Тrue                    End If                Case "заголовок 2"                    IsZag1 = Тrue                    If IsZag2 = False Then                        Rng.Offset(-2; 5) = res(j; 9)                        IsZag2 = Тrue                    End If                Case "заголовок 3"                    IsZag1 = Тrue                    IsZag2 = Тrue                    If IsZag3 = False Then                        Rng.Offset(-3; 5) = res(j; 9)                        IsZag3 = Тrue                    End If                End Select            Next        End If    NextEnd Sub
[/vba]

Автор - doober
Дата добавления - 04.11.2024 в 18:39
timo64uk Дата: Вторник, 05.11.2024, 02:22 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 121
Репутация: 1 ±
Замечаний: 0% ±

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

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


Сообщение отредактировал timo64uk - Вторник, 05.11.2024, 02:43
 
Ответить
Сообщение
Цитата doober, 04.11.2024 в 18:39, в сообщении № 2 ( писал(а)):
работает

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

Автор - timo64uk
Дата добавления - 05.11.2024 в 02:22
timo64uk Дата: Вторник, 05.11.2024, 03:24 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 121
Репутация: 1 ±
Замечаний: 0% ±

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

Set Rng = Sh.Range("A6")


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

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



Сообщение отредактировал timo64uk - Вторник, 05.11.2024, 04:01
 
Ответить
Сообщение
Цитата 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 в 03:24
doober Дата: Вторник, 05.11.2024, 16:30 | Сообщение № 5
Группа: Друзья
Ранг: Ветеран
Сообщений: 983
Репутация: 340 ±
Замечаний: 0% ±

Excel 2010
Примерно так.

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





Сообщение отредактировал doober - Вторник, 05.11.2024, 16:31
 
Ответить
СообщениеПримерно так.[vba]
Sub Тest()    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 = "ВЫДЕЛИТЬ * 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 IsЧull(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 = Тrue                        End If                    Case "заголовок 2"                        IsZag1 = Тrue                        If IsZag2 = False Then                            cel.Offset(-2; 5) = res(j; 9)                            IsZag2 = Тrue                        End If                    Case "заголовок 3"                        IsZag1 = Тrue                        IsZag2 = Тrue                        If IsZag3 = False Then                            cel.Offset(-3; 5) = res(j; 9)                            IsZag3 = Тrue                        End If                    End Select                Next            End If        Next    NextEnd Sub
[/vba]

Автор - doober
Дата добавления - 05.11.2024 в 16:30
timo64uk Дата: Среда, 06.11.2024, 08:30 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 121
Репутация: 1 ±
Замечаний: 0% ±

Office16
Цитата doober, 05.11.2024 в 16:30, в сообщении № 5 ( писал(а)):
так

Спасибо. Шикарно работает. Пустые ячейки базы 1111 заполнил, чтобы пустоту не воспринимал.
 
Ответить
Сообщение
Цитата doober, 05.11.2024 в 16:30, в сообщении № 5 ( писал(а)):
так

Спасибо. Шикарно работает. Пустые ячейки базы 1111 заполнил, чтобы пустоту не воспринимал.

Автор - timo64uk
Дата добавления - 06.11.2024 в 08:30
  • Страница 1 из 1
  • 1
Поиск:

Рейтинг@Mail.ru Яндекс.Метрика Яндекс цитирования
© 2010-2025 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!