Доброго времени суток! Имеются файлы с названиями соответствующим датам месяца (1,2,3...31). Необходим макрос для переноса значении со столбца "S" с файла "n-1" в столбец "АЕ" файла "n" в соответствующую номеру скв. (столбец G) строку. Например с файла "1" лист ОПФ столбец "S" Дебит нефти замер (т/сут) 1,3 соответствующий скважине 1119(столбец "G") переносит в файл "2" лист ОПФ в столбец "АЕ" напротив скв. 1119
Доброго времени суток! Имеются файлы с названиями соответствующим датам месяца (1,2,3...31). Необходим макрос для переноса значении со столбца "S" с файла "n-1" в столбец "АЕ" файла "n" в соответствующую номеру скв. (столбец G) строку. Например с файла "1" лист ОПФ столбец "S" Дебит нефти замер (т/сут) 1,3 соответствующий скважине 1119(столбец "G") переносит в файл "2" лист ОПФ в столбец "АЕ" напротив скв. 1119азик
азик, добрый день! При просмотре Ваше файлика, я заметил, что номера скважины 493 в приложенном Вами примере, повторяются 2 раза. У Вас могут быть повторы такие в файлах? если да, то какое соответствие Вы хотите задать? какие данные для одинаковых номеров скважин будут переноситься в другой файл?? или как вы планируете среди этих двух строк отсеивать данные для загрузки на другой лист?
азик, добрый день! При просмотре Ваше файлика, я заметил, что номера скважины 493 в приложенном Вами примере, повторяются 2 раза. У Вас могут быть повторы такие в файлах? если да, то какое соответствие Вы хотите задать? какие данные для одинаковых номеров скважин будут переноситься в другой файл?? или как вы планируете среди этих двух строк отсеивать данные для загрузки на другой лист?Roman777
номера скважины 493 в приложенном Вами примере, повторяются 2 раза.
Да но они в разных цехах. Скорее всего ВПР или ПОИСКПОЗ подойдет. - что - то я не понял куда Вы хотите подставить данные файл один - а Вы пишете про второй? . Удалите из примера лишние листы - они путают, а второй файл - не помешал бы и выделите цветом нужные колонки.
номера скважины 493 в приложенном Вами примере, повторяются 2 раза.
Да но они в разных цехах. Скорее всего ВПР или ПОИСКПОЗ подойдет. - что - то я не понял куда Вы хотите подставить данные файл один - а Вы пишете про второй? . Удалите из примера лишние листы - они путают, а второй файл - не помешал бы и выделите цветом нужные колонки.SLAVICK
Иногда все проще чем кажется с первого взгляда.
Сообщение отредактировал SLAVICK - Среда, 04.11.2015, 14:34
Sub perenos2() Dim i As Long, i_n As Long, j As Long, i2 As Long, n As Long, j_n As Long Dim ActWB As Workbook, WB As Workbook Dim sht As Worksheet Dim nameWB As String, path1 As String, Ras As String, nameWB2 As String, nameWB3 As String Dim shtname As String, key As String shtname = "ОПФ" Dim nameSKV As Object Ras = ".xls" j_n = 31 Application.ScreenUpdating = False For j = 2 To j_n If Dir(ThisWorkbook.Path & "\" & j & Ras) <> "" Then Set nameSKV = CreateObject("scripting.dictionary") If ActWB Is Nothing Then Workbooks.Open ThisWorkbook.Path & "\" & j & Ras Set ActWB = ActiveWorkbook End If i_n = ActWB.Worksheets(shtname).Cells(Rows.Count, 4).End(xlUp).Row nameWB = ActWB.Name path1 = ActWB.Path nameWB2 = Left(nameWB, Len(nameWB) - Len(Ras)) For i = 7 To i_n key = ActWB.Worksheets(shtname).Cells(i, 7) & ActWB.Worksheets(shtname).Cells(i, 8) If Not nameSKV.exists(key) Then nameSKV.Add key, ActWB.Worksheets(shtname).Cells(i, 19) End If Next i For i2 = 1 To 30 n = nameWB2 + i2 If Dir(path1 & "\" & n & Ras) <> "" Then nameWB3 = n Exit For Else If j < j_n Then j = j + 1 Else Exit Sub End If End If Next i2 Workbooks.Open (path1 & "\" & nameWB3 & Ras) Set WB = ActiveWorkbook i_n = WB.Worksheets(shtname).Cells(Rows.Count, 4).End(xlUp).Row For i = 1 To i_n key = WB.Worksheets(shtname).Cells(i, 7) & WB.Worksheets(shtname).Cells(i, 8) If nameSKV.exists(key) Then WB.Worksheets(shtname).Cells(i, 31) = nameSKV(key) End If Next i Application.DisplayAlerts = False ActWB.Close , True Application.DisplayAlerts = True Set ActWB = WB End If Next j Application.ScreenUpdating = True End Sub
[/vba]
В отдельном файле над запускать (Можете взять вложенный файл) и положить его в папку с Вашими файликами (у которых наименования соответствуют дате).
азик, на скок сообразил...
[vba]
Код
Sub perenos2() Dim i As Long, i_n As Long, j As Long, i2 As Long, n As Long, j_n As Long Dim ActWB As Workbook, WB As Workbook Dim sht As Worksheet Dim nameWB As String, path1 As String, Ras As String, nameWB2 As String, nameWB3 As String Dim shtname As String, key As String shtname = "ОПФ" Dim nameSKV As Object Ras = ".xls" j_n = 31 Application.ScreenUpdating = False For j = 2 To j_n If Dir(ThisWorkbook.Path & "\" & j & Ras) <> "" Then Set nameSKV = CreateObject("scripting.dictionary") If ActWB Is Nothing Then Workbooks.Open ThisWorkbook.Path & "\" & j & Ras Set ActWB = ActiveWorkbook End If i_n = ActWB.Worksheets(shtname).Cells(Rows.Count, 4).End(xlUp).Row nameWB = ActWB.Name path1 = ActWB.Path nameWB2 = Left(nameWB, Len(nameWB) - Len(Ras)) For i = 7 To i_n key = ActWB.Worksheets(shtname).Cells(i, 7) & ActWB.Worksheets(shtname).Cells(i, 8) If Not nameSKV.exists(key) Then nameSKV.Add key, ActWB.Worksheets(shtname).Cells(i, 19) End If Next i For i2 = 1 To 30 n = nameWB2 + i2 If Dir(path1 & "\" & n & Ras) <> "" Then nameWB3 = n Exit For Else If j < j_n Then j = j + 1 Else Exit Sub End If End If Next i2 Workbooks.Open (path1 & "\" & nameWB3 & Ras) Set WB = ActiveWorkbook i_n = WB.Worksheets(shtname).Cells(Rows.Count, 4).End(xlUp).Row For i = 1 To i_n key = WB.Worksheets(shtname).Cells(i, 7) & WB.Worksheets(shtname).Cells(i, 8) If nameSKV.exists(key) Then WB.Worksheets(shtname).Cells(i, 31) = nameSKV(key) End If Next i Application.DisplayAlerts = False ActWB.Close , True Application.DisplayAlerts = True Set ActWB = WB End If Next j Application.ScreenUpdating = True End Sub
[/vba]
В отдельном файле над запускать (Можете взять вложенный файл) и положить его в папку с Вашими файликами (у которых наименования соответствуют дате).Roman777
Сразу добавлю, что я предположил что на одной площади одинаковых номеров скважин нет, поэтому уникальность определяется номером скважины и наименованием площади (следующий столбец за номером скважины).
Сразу добавлю, что я предположил что на одной площади одинаковых номеров скважин нет, поэтому уникальность определяется номером скважины и наименованием площади (следующий столбец за номером скважины).Roman777
азик, добрый день! Прошу прощения, я в макросе привязывался к формату xls. Сейчас подправил. И ещё ошибочка была - начинал со 2-го числа месяца (первый вариант макроса, который я в итоге переделал и сюда не выкладывал, предусматривал немного другую логику). На данный момент, макрос работает с наименованиями 1-31.xlsx. Если надо по-другому, можно подправить.
азик, добрый день! Прошу прощения, я в макросе привязывался к формату xls. Сейчас подправил. И ещё ошибочка была - начинал со 2-го числа месяца (первый вариант макроса, который я в итоге переделал и сюда не выкладывал, предусматривал немного другую логику). На данный момент, макрос работает с наименованиями 1-31.xlsx. Если надо по-другому, можно подправить.Roman777
Roman777, добрый день! Всё, заработал! Спасибо большое!:)А по какому принципу происходит открывание файлов, просто 2 последних файла? Если в папке 1-15 файлов макрос откроет 14,15?
Roman777, добрый день! Всё, заработал! Спасибо большое!:)А по какому принципу происходит открывание файлов, просто 2 последних файла? Если в папке 1-15 файлов макрос откроет 14,15?азик
азик, должен был остаться открыт только 15-й... проверьте, пожалуйста, данные правильно скопировались? Я сейчас, к сожалению, сильно занят, не смогу поглубже в коде проверить наличие ошибки. А вообще, принцип такой: Открывает с 1й, открывает 2й. И копирует из предыдущего в следующий данные (избирая по номеру скважины + наименованию площади). Далее открывает 3й, записывает данные из 2-го и т.д. по 15й. Если нет файла, допустим 4, то он открывает 5й и в него пишет данные из 3-го файла...
азик, должен был остаться открыт только 15-й... проверьте, пожалуйста, данные правильно скопировались? Я сейчас, к сожалению, сильно занят, не смогу поглубже в коде проверить наличие ошибки. А вообще, принцип такой: Открывает с 1й, открывает 2й. И копирует из предыдущего в следующий данные (избирая по номеру скважины + наименованию площади). Далее открывает 3й, записывает данные из 2-го и т.д. по 15й. Если нет файла, допустим 4, то он открывает 5й и в него пишет данные из 3-го файла...Roman777
азик, странно, Вы макрос запускали из файла, который я Вам скинул? У меня остаётся открытым только файл запуска и последний файлик (15й), как и планировалось. Единственное, было пару ошибок, из-за которых, изменения в файлах при их закрытии не сохранялись. Поправил, сейчас работает как надо. (остаётся открытым только файл запуска и последний файлик (15й)).
[vba]
Код
Sub perenos2() Dim i As Long, i_n As Long, j As Long, i2 As Long, n As Long, j_n As Long Dim ActWB As Workbook, WB As Workbook Dim sht As Worksheet Dim nameWB As String, path1 As String, Ras As String, nameWB2 As String, nameWB3 As String Dim shtname As String, key As String shtname = "ОПФ" Dim nameSKV As Object Ras = ".xlsx" j_n = 31 Application.ScreenUpdating = False For j = 1 To j_n If Dir(ThisWorkbook.Path & "\" & j & Ras) <> "" Then Set nameSKV = CreateObject("scripting.dictionary") If ActWB Is Nothing Then Workbooks.Open ThisWorkbook.Path & "\" & j & Ras Set ActWB = ActiveWorkbook End If i_n = ActWB.Worksheets(shtname).Cells(Rows.Count, 4).End(xlUp).Row nameWB = ActWB.Name path1 = ActWB.Path nameWB2 = Left(nameWB, Len(nameWB) - Len(Ras)) For i = 7 To i_n key = ActWB.Worksheets(shtname).Cells(i, 7) & ActWB.Worksheets(shtname).Cells(i, 8) If key <> "" Then If Not nameSKV.exists(key) Then nameSKV.Add key, ActWB.Worksheets(shtname).Cells(i, 19) End If End If Next i For i2 = 1 To 30 n = nameWB2 + i2 If Dir(path1 & "\" & n & Ras) <> "" Then nameWB3 = n Exit For Else If j < j_n Then j = j + 1 Else Exit Sub End If End If Next i2 Workbooks.Open (path1 & "\" & nameWB3 & Ras) Set WB = ActiveWorkbook i_n = WB.Worksheets(shtname).Cells(Rows.Count, 4).End(xlUp).Row For i = 1 To i_n key = WB.Worksheets(shtname).Cells(i, 7) & WB.Worksheets(shtname).Cells(i, 8) If nameSKV.exists(key) Then WB.Worksheets(shtname).Cells(i, 31) = nameSKV(key) End If Next i Application.DisplayAlerts = False ActWB.Close (True) Application.DisplayAlerts = True Set ActWB = WB End If Next j Application.ScreenUpdating = True End Sub
[/vba]
азик, странно, Вы макрос запускали из файла, который я Вам скинул? У меня остаётся открытым только файл запуска и последний файлик (15й), как и планировалось. Единственное, было пару ошибок, из-за которых, изменения в файлах при их закрытии не сохранялись. Поправил, сейчас работает как надо. (остаётся открытым только файл запуска и последний файлик (15й)).
[vba]
Код
Sub perenos2() Dim i As Long, i_n As Long, j As Long, i2 As Long, n As Long, j_n As Long Dim ActWB As Workbook, WB As Workbook Dim sht As Worksheet Dim nameWB As String, path1 As String, Ras As String, nameWB2 As String, nameWB3 As String Dim shtname As String, key As String shtname = "ОПФ" Dim nameSKV As Object Ras = ".xlsx" j_n = 31 Application.ScreenUpdating = False For j = 1 To j_n If Dir(ThisWorkbook.Path & "\" & j & Ras) <> "" Then Set nameSKV = CreateObject("scripting.dictionary") If ActWB Is Nothing Then Workbooks.Open ThisWorkbook.Path & "\" & j & Ras Set ActWB = ActiveWorkbook End If i_n = ActWB.Worksheets(shtname).Cells(Rows.Count, 4).End(xlUp).Row nameWB = ActWB.Name path1 = ActWB.Path nameWB2 = Left(nameWB, Len(nameWB) - Len(Ras)) For i = 7 To i_n key = ActWB.Worksheets(shtname).Cells(i, 7) & ActWB.Worksheets(shtname).Cells(i, 8) If key <> "" Then If Not nameSKV.exists(key) Then nameSKV.Add key, ActWB.Worksheets(shtname).Cells(i, 19) End If End If Next i For i2 = 1 To 30 n = nameWB2 + i2 If Dir(path1 & "\" & n & Ras) <> "" Then nameWB3 = n Exit For Else If j < j_n Then j = j + 1 Else Exit Sub End If End If Next i2 Workbooks.Open (path1 & "\" & nameWB3 & Ras) Set WB = ActiveWorkbook i_n = WB.Worksheets(shtname).Cells(Rows.Count, 4).End(xlUp).Row For i = 1 To i_n key = WB.Worksheets(shtname).Cells(i, 7) & WB.Worksheets(shtname).Cells(i, 8) If nameSKV.exists(key) Then WB.Worksheets(shtname).Cells(i, 31) = nameSKV(key) End If Next i Application.DisplayAlerts = False ActWB.Close (True) Application.DisplayAlerts = True Set ActWB = WB End If Next j Application.ScreenUpdating = True End Sub
Ну и например если новая скважина появилась 5го числа, то его ставить в кучку по площади
Вот тут поясните, пожалуйста подробней... Я попробую, коли время будет сделать...) Появится совершенно новая строчка в файле? тобишь её ниже нынешней ЧЦДНГ 05 493 Яркеевская (строка 165 из вашего файла) записывать?
Ну и например если новая скважина появилась 5го числа, то его ставить в кучку по площади
Вот тут поясните, пожалуйста подробней... Я попробую, коли время будет сделать...) Появится совершенно новая строчка в файле? тобишь её ниже нынешней ЧЦДНГ 05 493 Яркеевская (строка 165 из вашего файла) записывать?Roman777
азик, проверьте пожалуйста. Я на нетбуке делал, проверял частично. Обращаю Ваше внимание, у Вас в файликах (1-31) имеются в конце таблицы минитаблички с подсчётами, они были выделены цветом. Данные таблички мне мешали вести подсчёт нужных строк, поэтому я сделал проверку на цвет ячейки (это замедлило работу и подразумевает, то и в предь вы будете лишние снизу таблички выделять цветом, а ячейки нужной таблицы так и останутся белые). Макрос отрабатывая, так же копирует инфу в строку АЕ и оставляет только файл запуска с уже занесёнными данными... далее я сделал сортировку по наименованию площади, чтобы не пришлось делать лишних циклов для
то его добавлять к кучке скважин юсуповской площади-куда нить от скв417до скв672б
Проверьте, пожалуйста, правильно ли считается дельта...
азик, проверьте пожалуйста. Я на нетбуке делал, проверял частично. Обращаю Ваше внимание, у Вас в файликах (1-31) имеются в конце таблицы минитаблички с подсчётами, они были выделены цветом. Данные таблички мне мешали вести подсчёт нужных строк, поэтому я сделал проверку на цвет ячейки (это замедлило работу и подразумевает, то и в предь вы будете лишние снизу таблички выделять цветом, а ячейки нужной таблицы так и останутся белые). Макрос отрабатывая, так же копирует инфу в строку АЕ и оставляет только файл запуска с уже занесёнными данными... далее я сделал сортировку по наименованию площади, чтобы не пришлось делать лишних циклов для