Добрый день. В активной книге, на активном листе, в столбце 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 - вставляем. Пока писал что нужно сделать, то ловил себя на мысли, что это что-то фантастическое и на грани здравого смысла.
Добрый день. В активной книге, на активном листе, в столбце 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
крыша поехала.Как работает, не представляю.Заточите под себя
Sub Test() Dim oConn AsObject, Sh As Worksheet, Rng As Range Dim objRS AsObject, IsZag1 AsBoolean, IsZag2 AsBoolean, IsZag3 AsBoolean 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(1To li + 1, 1ToUBound(avr) + 1) For n = 0ToUBound(avr)
res(1, n + 1) = objRS.Fields(n).Name Next
For n = 0ToUBound(avr, 2) For i = 0ToUBound(avr) IfNotIsNull(avr(i, n)) Then
res(n + 2, i + 1) = avr(i, n) EndIf Next Next
IsZag1 = False
IsZag2 = False
IsZag3 = False
For n = 1ToUBound(res)
Key$ = res(n, 1) If Key = Art Then For j = n - 1To1Step -1
заголовок = res(j, 2) SelectCase заголовок Case"заголовок 1" If IsZag1 = FalseThen
Rng.Offset(-1, 5) = res(j, 9)
IsZag1 = True EndIf Case"заголовок 2"
IsZag1 = True If IsZag2 = FalseThen
Rng.Offset(-2, 5) = res(j, 9)
IsZag2 = True EndIf Case"заголовок 3"
IsZag1 = True
IsZag2 = True If IsZag3 = FalseThen
Rng.Offset(-3, 5) = res(j, 9)
IsZag3 = True EndIf EndSelect Next EndIf Next EndSub
крыша поехала.Как работает, не представляю.Заточите под себя
Sub Test() Dim oConn AsObject, Sh As Worksheet, Rng As Range Dim objRS AsObject, IsZag1 AsBoolean, IsZag2 AsBoolean, IsZag3 AsBoolean 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(1To li + 1, 1ToUBound(avr) + 1) For n = 0ToUBound(avr)
res(1, n + 1) = objRS.Fields(n).Name Next
For n = 0ToUBound(avr, 2) For i = 0ToUBound(avr) IfNotIsNull(avr(i, n)) Then
res(n + 2, i + 1) = avr(i, n) EndIf Next Next
IsZag1 = False
IsZag2 = False
IsZag3 = False
For n = 1ToUBound(res)
Key$ = res(n, 1) If Key = Art Then For j = n - 1To1Step -1
заголовок = res(j, 2) SelectCase заголовок Case"заголовок 1" If IsZag1 = FalseThen
Rng.Offset(-1, 5) = res(j, 9)
IsZag1 = True EndIf Case"заголовок 2"
IsZag1 = True If IsZag2 = FalseThen
Rng.Offset(-2, 5) = res(j, 9)
IsZag2 = True EndIf Case"заголовок 3"
IsZag1 = True
IsZag2 = True If IsZag3 = FalseThen
Rng.Offset(-3, 5) = res(j, 9)
IsZag3 = True EndIf EndSelect Next EndIf Next EndSub
Спасибо огромное. Я примерно представлял количество условий IF, но не думал, что это вообще реально. Фантастика. *** Вы просто красавчик. Оно работает. Это действительно волшебство. Спасибо
Спасибо огромное. Я примерно представлял количество условий IF, но не думал, что это вообще реально. Фантастика. *** Вы просто красавчик. Оно работает. Это действительно волшебство. Спасибоtimo64uk
Сообщение отредактировал timo64uk - Вторник, 05.11.2024, 02:43
Sub Test() Dim oConn AsObject, Sh As Worksheet, Rng As Range Dim objRS AsObject, IsZag1 AsBoolean, IsZag2 AsBoolean, IsZag3 AsBoolean 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(1To li + 1, 1ToUBound(avr) + 1) For n = 0ToUBound(avr)
res(1, n + 1) = objRS.Fields(n).Name Next
For n = 0ToUBound(avr, 2) For i = 0ToUBound(avr) IfNotIsNull(avr(i, n)) Then
res(n + 2, i + 1) = avr(i, n) EndIf Next Next For Each cel In Rng
Art$ = cel
IsZag1 = False
IsZag2 = False
IsZag3 = False
For n = 1ToUBound(res)
Key$ = res(n, 1) If Key = Art Then For j = n - 1To1Step -1
заголовок = res(j, 2) SelectCase заголовок Case"заголовок 1" If IsZag1 = FalseThen
cel.Offset(-1, 5) = res(j, 9)
IsZag1 = True EndIf Case"заголовок 2"
IsZag1 = True If IsZag2 = FalseThen
cel.Offset(-2, 5) = res(j, 9)
IsZag2 = True EndIf Case"заголовок 3"
IsZag1 = True
IsZag2 = True If IsZag3 = FalseThen
cel.Offset(-3, 5) = res(j, 9)
IsZag3 = True EndIf EndSelect Next EndIf Next Next
EndSub
Примерно так.
Sub Test() Dim oConn AsObject, Sh As Worksheet, Rng As Range Dim objRS AsObject, IsZag1 AsBoolean, IsZag2 AsBoolean, IsZag3 AsBoolean 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(1To li + 1, 1ToUBound(avr) + 1) For n = 0ToUBound(avr)
res(1, n + 1) = objRS.Fields(n).Name Next
For n = 0ToUBound(avr, 2) For i = 0ToUBound(avr) IfNotIsNull(avr(i, n)) Then
res(n + 2, i + 1) = avr(i, n) EndIf Next Next For Each cel In Rng
Art$ = cel
IsZag1 = False
IsZag2 = False
IsZag3 = False
For n = 1ToUBound(res)
Key$ = res(n, 1) If Key = Art Then For j = n - 1To1Step -1
заголовок = res(j, 2) SelectCase заголовок Case"заголовок 1" If IsZag1 = FalseThen
cel.Offset(-1, 5) = res(j, 9)
IsZag1 = True EndIf Case"заголовок 2"
IsZag1 = True If IsZag2 = FalseThen
cel.Offset(-2, 5) = res(j, 9)
IsZag2 = True EndIf Case"заголовок 3"
IsZag1 = True
IsZag2 = True If IsZag3 = FalseThen
cel.Offset(-3, 5) = res(j, 9)
IsZag3 = True EndIf EndSelect Next EndIf Next Next