Добрый день В активной книге на активном листе в столбце "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" внес "-" (не знаю поможет ли это в данном случае). Помощи прошу вашей.
Добрый день В активной книге на активном листе в столбце "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
Добрый.Вы так сложно объясняете все, надо проще. Сделано на базе предыдущего макроса.[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
Добрый день. Прекрасный код. Везде его пользую, и заменяет ВПР, Индекс, ПросмотрХ и СУММесли. Подскажите, пожалуйста, что нужно сделать, чтобы и из столбца X также вставлял в M в этом же коде (обычно я переменные меняю и вставляю подряд коды... ). Честно пытался ss2 "привить", но не приживается у меня. *** Ой, мы уже это делали в коде, на основе, которого вы разработали этот код. Я уже по замкнутому кругу пошел))). Все хорошо.
Добрый день. Прекрасный код. Везде его пользую, и заменяет ВПР, Индекс, ПросмотрХ и СУММесли. Подскажите, пожалуйста, что нужно сделать, чтобы и из столбца X также вставлял в M в этом же коде (обычно я переменные меняю и вставляю подряд коды... ). Честно пытался ss2 "привить", но не приживается у меня. *** Ой, мы уже это делали в коде, на основе, которого вы разработали этот код. Я уже по замкнутому кругу пошел))). Все хорошо.timo64uk
Сообщение отредактировал timo64uk - Суббота, 23.11.2024, 10:03