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

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Из книги подтянуть значения в активный лист после слова - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Из книги подтянуть значения в активный лист после слова
timo64uk Дата: Суббота, 09.11.2024, 11:04 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 104
Репутация: 1 ±
Замечаний: 0% ±

Office16
Добрый день :)
В активной книге на активном листе в столбце "C" есть слово "от Заказчика" (строка не известна, и название книги и листа неизвестны),
ниже данного слова в столбце "A" встречаются значения-критерии вперемешку с пустыми ячейками (в примере их всего 2, но в реалиях больше).
Нужно найти данные значения-критерии в книге по известному пути и названиям файла: "C:\Новая папка\БД.xlsx" на листе "1111" в столбце "A"
и в строке напротив найденных сложить значения из столбца "U", а результат сложения вставить в первоначальную активную книгу, активный лист, в столбец "L" в строку, содержащую соответствующее значение-критерий в столбце "A" (т.е. напротив).
В примере значение-критерии: "4.1.1.29.500+51+AFA17BC21" и "4.1.1.29.500+51+AFA17BC41".
Чтобы пустые ячейки из 2222 столбца "A", не воспринимались как значения-критерии, то в 1111 в столбце "A" внес "-" (не знаю поможет ли это в данном случае).
Помощи прошу вашей.
К сообщению приложен файл: 1111.xlsx (14.5 Kb) · 2222.xlsx (220.9 Kb)


Сообщение отредактировал timo64uk - Суббота, 09.11.2024, 11:04
 
Ответить
СообщениеДобрый день :)
В активной книге на активном листе в столбце "C" есть слово "от Заказчика" (строка не известна, и название книги и листа неизвестны),
ниже данного слова в столбце "A" встречаются значения-критерии вперемешку с пустыми ячейками (в примере их всего 2, но в реалиях больше).
Нужно найти данные значения-критерии в книге по известному пути и названиям файла: "C:\Новая папка\БД.xlsx" на листе "1111" в столбце "A"
и в строке напротив найденных сложить значения из столбца "U", а результат сложения вставить в первоначальную активную книгу, активный лист, в столбец "L" в строку, содержащую соответствующее значение-критерий в столбце "A" (т.е. напротив).
В примере значение-критерии: "4.1.1.29.500+51+AFA17BC21" и "4.1.1.29.500+51+AFA17BC41".
Чтобы пустые ячейки из 2222 столбца "A", не воспринимались как значения-критерии, то в 1111 в столбце "A" внес "-" (не знаю поможет ли это в данном случае).
Помощи прошу вашей.

Автор - timo64uk
Дата добавления - 09.11.2024 в 11:04
doober Дата: Суббота, 09.11.2024, 12:55 | Сообщение № 2
Группа: Друзья
Ранг: Ветеран
Сообщений: 981
Репутация: 336 ±
Замечаний: 0% ±

Excel 2010
Добрый.Вы так сложно объясняете все, надо проще.
Сделано на базе предыдущего макроса.[vba]
Код
Sub Test2()
    Dim oConn As Object, Sh As Worksheet, Rng As Range
    Dim objRS As Object, IsStart As Boolean
    Dim sPath, avr, cel As Range
    Set List = CreateObject("scripting.dictionary")
    Set Sh = ActiveSheet
    LastRow = Sh.Cells(Sh.Rows.Count, "A").End(xlUp).Row

    Set xx = Sh.Columns("C:C").Find("от Заказчика", , , xlWhole)
    If xx Is Nothing Then Exit Sub
    Set Rng = Sh.Range("A" & (xx.Row + 1) & ":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
        If IsStart = True Then
            Key$ = res(n + 1, 1)
            If Key$ <> "" Then
                ss = Val(Replace(res(n + 1, 21), ",", "."))
                If List.Exists(Key) Then
                    List.Item(Key) = List.Item(Key) + ss
                Else
                    List.Item(Key) = ss
                End If

            End If
        End If
        If res(n + 1, 1) = "Ключ" Then
            IsStart = True
        End If

    Next
    For Each cel In Rng
        Key$ = cel
        If Key <> "" Then
            If List.Exists(Key) Then
                ss = List.Item(Key)
                cel.Offset(0, 11) = ss
            End If
        End If
    Next
End Sub
[/vba]


 
Ответить
СообщениеДобрый.Вы так сложно объясняете все, надо проще.
Сделано на базе предыдущего макроса.[vba]
Код
Sub Test2()
    Dim oConn As Object, Sh As Worksheet, Rng As Range
    Dim objRS As Object, IsStart As Boolean
    Dim sPath, avr, cel As Range
    Set List = CreateObject("scripting.dictionary")
    Set Sh = ActiveSheet
    LastRow = Sh.Cells(Sh.Rows.Count, "A").End(xlUp).Row

    Set xx = Sh.Columns("C:C").Find("от Заказчика", , , xlWhole)
    If xx Is Nothing Then Exit Sub
    Set Rng = Sh.Range("A" & (xx.Row + 1) & ":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
        If IsStart = True Then
            Key$ = res(n + 1, 1)
            If Key$ <> "" Then
                ss = Val(Replace(res(n + 1, 21), ",", "."))
                If List.Exists(Key) Then
                    List.Item(Key) = List.Item(Key) + ss
                Else
                    List.Item(Key) = ss
                End If

            End If
        End If
        If res(n + 1, 1) = "Ключ" Then
            IsStart = True
        End If

    Next
    For Each cel In Rng
        Key$ = cel
        If Key <> "" Then
            If List.Exists(Key) Then
                ss = List.Item(Key)
                cel.Offset(0, 11) = ss
            End If
        End If
    Next
End Sub
[/vba]

Автор - doober
Дата добавления - 09.11.2024 в 12:55
timo64uk Дата: Воскресенье, 10.11.2024, 03:47 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 104
Репутация: 1 ±
Замечаний: 0% ±

Office16
на базе предыдущего макроса

Спасибо огромное. Пытался на его основе, но... "заголовки" не смог обойти (рано мне еще такое делать).
 
Ответить
Сообщение
на базе предыдущего макроса

Спасибо огромное. Пытался на его основе, но... "заголовки" не смог обойти (рано мне еще такое делать).

Автор - timo64uk
Дата добавления - 10.11.2024 в 03:47
timo64uk Дата: Пятница, 22.11.2024, 12:35 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 104
Репутация: 1 ±
Замечаний: 0% ±

Office16
надо

Добрый день. Прекрасный код. Везде его пользую, и заменяет ВПР, Индекс, ПросмотрХ и СУММесли.
Подскажите, пожалуйста, что нужно сделать, чтобы и из столбца X также вставлял в M в этом же коде (обычно я переменные меняю и вставляю подряд коды... ).
Честно пытался ss2 "привить", но не приживается у меня.
***
Ой, мы уже это делали в коде, на основе, которого вы разработали этот код.
Я уже по замкнутому кругу пошел))). Все хорошо.


Сообщение отредактировал timo64uk - Суббота, 23.11.2024, 10:03
 
Ответить
Сообщение
надо

Добрый день. Прекрасный код. Везде его пользую, и заменяет ВПР, Индекс, ПросмотрХ и СУММесли.
Подскажите, пожалуйста, что нужно сделать, чтобы и из столбца X также вставлял в M в этом же коде (обычно я переменные меняю и вставляю подряд коды... ).
Честно пытался ss2 "привить", но не приживается у меня.
***
Ой, мы уже это делали в коде, на основе, которого вы разработали этот код.
Я уже по замкнутому кругу пошел))). Все хорошо.

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

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