Мне нужно найти средневзвешенные/среднеинтегральные значения отклонений столбца D от столбца E в % за месяц и за год. Подскажите, пожалуйста, какой формулой это можно сделать.
В идеале сделать что-то подобное, как в столбцах O и P с суммой
Изменено: - 06.11.2024 08:33:05
Замена в макросе обычной формулы на формулу массива
Пользователь
Сообщений: Регистрация: 09.09.2022
26.07.2024 08:44:52
Добрый день!
Мне нужно сложным поиском забирать данные из одного файла в другой, получилось это сделать только формулой массива, сейчас хочу вставлять эту формулу макросом, макрос готовый уже есть, но он вставляет ее в определенные ячейки как обычную формулу, т.е если я открою файл и прожму ctrl+shift+enter, то появится корректное значение в ячейке.
Подскажите, пожалуйста, как мне поправить макрос, чтоб сразу вставлял данную формулу как формулу массива?
Формула в чистом виде {=ИНДЕКС(Ф4!$D$425:$AE$457; ПОИСКПОЗ($D11;Ф4!$A$425:$A$475;0); ПОИСКПОЗ('Справочник ГТП'!$F$7&H$9; Ф4!$D$422:$AE$422&Ф4!$D$423:$AE$423; 0))}
Макрос для вставки
Код
Public fso As Object
Sub ВставитьФормулу()
Set fso = CreateObject("Scripting.FileSystemObject")
Dim fullFrom As Variant
fullFrom = ShowFileDialog("Выберите файл источник", False)
If IsEmpty(fullFrom) Then Exit Sub
Dim fullTarg As Variant
fullTarg = ShowFileDialog("Выберите файлы приёмники", True)
If IsEmpty(fullTarg) Then Exit Sub
Dim wbFrom As Workbook
Set wbFrom = GetWb(fullFrom(1))
Dim vFull As Variant
For Each vFull In fullTarg
FillFormulasInWorkbook vFull, wbFrom
Next
wbFrom.Close False
End Sub
Private Sub FillFormulasInWorkbook(ByVal sFull As String, wbFrom As Workbook)
Dim rr As Range
Dim sh As Worksheet
Dim wb As Workbook
Set wb = GetWb(sFull)
If Not wb Is Nothing Then
Dim ss As String
Dim vMonth As Variant
For Each vMonth In Array("Ф4")
Set sh = wb.Sheets(vMonth)
Set rr = sh.Range("H11:I14")
ss = "=ЕСЛИОШИБКА(ИНДЕКС('[" & wbFrom.Name & "]Ф4'!$D$425:$AE$457;ПОИСКПОЗ($D11;'[" & wbFrom.Name & "]Ф4'!$A$425:$A$457;0);ПОИСКПОЗ('Справочник ГТП'!$F$7&H$9;'[" & wbFrom.Name & "]Ф4'!$D$422:$AE$422&'[" & wbFrom.Name & "]Ф4'!$D$423:$AE$423;0));" & """""" & ")"
ss = Replace(ss, "Ф4", vMonth)
rr.FormulaLocal = ss
Next
wb.RemovePersonalInformation = 0
wb.Close True
End If
End Sub
Private Function GetWb(ByVal sFull As String) As Workbook
Dim sName As String
sName = fso.GetFileName(sFull)
Dim wb As Workbook
On Error Resume Next
Set wb = Workbooks(sName)
On Error GoTo 0
If Not wb Is Nothing Then
If wb.FullName <> sFull Or wb.ReadOnly Then
wb.Close False
Set wb = Nothing
End If
End If
If wb Is Nothing Then
Set wb = Workbooks.Open(sFull, False, False)
End If
Set GetWb = wb
End Function
Private Function ShowFileDialog(sTitle As String, bAllowMultiSelect As Boolean) As Variant
Dim rInitialFileName As Range
On Error Resume Next
Set rInitialFileName = ThisWorkbook.Names("Файл").RefersToRange
Dim oFD As FileDialog
Dim x, lf As Long
'назначаем переменной ссылку на экземпляр диалога
Set oFD = Application.FileDialog(msoFileDialogFilePicker)
With oFD 'используем короткое обращение к объекту
'так же можно без oFD
'With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = bAllowMultiSelect
.Title = sTitle
.Filters.Clear 'очищаем установленные ранее типы файлов
.Filters.Add "Excel files", "*.xls*", 1 'устанавливаем возможность выбора только файлов Excel
'.Filters.Add "Text files", "*.txt", 2 'добавляем возможность выбора текстовых файлов
.FilterIndex = 1 'устанавливаем тип файлов по умолчанию - Text files(Текстовые файлы)
.InitialFileName = rInitialFileName.Value
.InitialView = msoFileDialogViewDetails 'вид диалогового окна(доступно 9 вариантов)
If .Show = 0 Then Exit Function 'показывает диалог
Dim arr As Variant
'цикл по коллекции выбранных в диалоге файлов
For lf = 1 To .SelectedItems.Count
If Left(fso.GetFileName(.SelectedItems(lf)), 2) <> "~$" Then
If IsEmpty(arr) Then
ReDim arr(1 To 1)
If Not rInitialFileName Is Nothing Then rInitialFileName.Value = .SelectedItems(lf)
Else
ReDim Preserve arr(1 To UBound(arr) + 1)
End If
arr(UBound(arr)) = .SelectedItems(lf) 'считываем полный путь к файлу
End If
Next
ShowFileDialog = arr
End With
End Function
Изменено: - 26.07.2024 08:45:47
Перенос данных листа из одной книги в другую макросом
Пользователь
Сообщений: Регистрация: 09.09.2022
02.07.2024 12:11:57
Добрый день! У меня есть готовый макрос для вставки формулы, копирующей информацию из одной книги в другую, макрос предназначался для массива данных, т.е было несколько однотипных листов, данные копировались с этих листов и вставлялись в другую книгу формулой.
Сейчас ситуация проще, нужно взять выбранные ячейки и вставить эти ячейки на лист с таким же названием, но в другую книгу, подскажите, пожалуйста, как нужно изменить мой макрос? или может у кого-то готовый уже есть.
В данном примере я пытался изменить вот этот фрагмент For Each vMonth In Array("Ф4") - раньше тут был массив листов
Код
Public fso As Object
Sub ВставитьФормулу()
Set fso = CreateObject("Scripting.FileSystemObject")
Dim fullFrom As Variant
fullFrom = ShowFileDialog("Выберите файл источник", False)
If IsEmpty(fullFrom) Then Exit Sub
Dim fullTarg As Variant
fullTarg = ShowFileDialog("Выберите файлы приёмники", True)
If IsEmpty(fullTarg) Then Exit Sub
Dim wbFrom As Workbook
Set wbFrom = GetWb(fullFrom(1))
Dim vFull As Variant
For Each vFull In fullTarg
FillFormulasInWorkbook vFull, wbFrom
Next
wbFrom.Close False
End Sub
Private Sub FillFormulasInWorkbook(ByVal sFull As String, wbFrom As Workbook)
Dim rr As Range
Dim sh As Worksheet
Dim wb As Workbook
Set wb = GetWb(sFull)
If Not wb Is Nothing Then
Dim ss As String
Dim vMonth As Variant
For Each vMonth In Array("Ф4")
Set sh = wb.Sheets(vMonth)
Set rr = sh.Range("G11:I14, K11:W14, Y11:Z14,G22:I22, K22:W22, Y22:Z22,G27:I27, K27:W27, Y27:Z27,Y36:Z36,G36:I36, K36:W36, Y36:Z36")
ss = "=ЕСЛИОШИБКА(ИНДЕКС('[" & wbFrom.Name & "]Ф4'!$G$11:$Z$67;ПОИСКПОЗ($D11;'[" & wbFrom.Name & "]Ф4'!$D$11:$D$67;0);ПОИСКПОЗ(G$9;'[" & wbFrom.Name & "]Ф4'!$G$9:$Z$9;0));" & """""" & ")"
ss = Replace(ss, "Январь", vMonth)
rr.FormulaLocal = ss
Next
wb.RemovePersonalInformation = 0
wb.Close True
End If
End Sub
Private Function GetWb(ByVal sFull As String) As Workbook
Dim sName As String
sName = fso.GetFileName(sFull)
Dim wb As Workbook
On Error Resume Next
Set wb = Workbooks(sName)
On Error GoTo 0
If Not wb Is Nothing Then
If wb.FullName <> sFull Or wb.ReadOnly Then
wb.Close False
Set wb = Nothing
End If
End If
If wb Is Nothing Then
Set wb = Workbooks.Open(sFull, False, False)
End If
Set GetWb = wb
End Function
Private Function ShowFileDialog(sTitle As String, bAllowMultiSelect As Boolean) As Variant
Dim rInitialFileName As Range
On Error Resume Next
Set rInitialFileName = ThisWorkbook.Names("Файл").RefersToRange
Dim oFD As FileDialog
Dim x, lf As Long
'назначаем переменной ссылку на экземпляр диалога
Set oFD = Application.FileDialog(msoFileDialogFilePicker)
With oFD 'используем короткое обращение к объекту
'так же можно без oFD
'With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = bAllowMultiSelect
.Title = sTitle
.Filters.Clear 'очищаем установленные ранее типы файлов
.Filters.Add "Excel files", "*.xls*", 1 'устанавливаем возможность выбора только файлов Excel
'.Filters.Add "Text files", "*.txt", 2 'добавляем возможность выбора текстовых файлов
.FilterIndex = 1 'устанавливаем тип файлов по умолчанию - Text files(Текстовые файлы)
.InitialFileName = rInitialFileName.Value
.InitialView = msoFileDialogViewDetails 'вид диалогового окна(доступно 9 вариантов)
If .Show = 0 Then Exit Function 'показывает диалог
Dim arr As Variant
'цикл по коллекции выбранных в диалоге файлов
For lf = 1 To .SelectedItems.Count
If Left(fso.GetFileName(.SelectedItems(lf)), 2) <> "~$" Then
If IsEmpty(arr) Then
ReDim arr(1 To 1)
If Not rInitialFileName Is Nothing Then rInitialFileName.Value = .SelectedItems(lf)
Else
ReDim Preserve arr(1 To UBound(arr) + 1)
End If
arr(UBound(arr)) = .SelectedItems(lf) 'считываем полный путь к файлу
End If
Next
ShowFileDialog = arr
End With
End Function
Подсчет переходов в строке с нуля на значение
Пользователь
Сообщений: Регистрация: 09.09.2022
20.03.2024 09:37:21
Добрый день!
Подскажите, пожалуйста, как посчитать в строке моменты перехода с числа на ноль и с нуля на число
В файле примере должно посчитаться так: Строка 1 = 4 Строка 2 = 6 Строка 3 = 2
Предсказание по нескольким столбцам
Пользователь
Сообщений: Регистрация: 09.09.2022
08.11.2023 09:15:20
Добрый день!
Нужно реализовать, чтоб вбивая значение столбца D(можно еще добавить значение месяца), находилось значение столбца C(используя прогнозирование/интерполяцию). Но при этом нужно учесть столбец A/B c наименованием месяцев, т.к в летние периоды значение в столбце С становится ниже.
Попробовал выводить уравнение полинома, функцию ПРЕДСКАЗ, но работает некорректно в данном случае.
Подскажите, пожалуйста, как это можно сделать.
Изменено: - 08.11.2023 09:35:53
Как убрать перекрытие данных на гистограмме?
Пользователь
Сообщений: Регистрация: 09.09.2022
17.08.2023 07:34:05
Добрый день!
Есть 2 столбца, на гистограмме нужно выделить значения этих столбцов разным цветом (отличие должно быть видно и для положительной, и для отрицательной части)
В моем файле есть 10 строк, для первых 7 данные совпали хорошо и можно увидеть какой результат я хочу получить. Для 8,9,10 происходит перекрытие, т.е столбец 2 полностью перекрывает выделенный другим цветом столбец 1.
Подскажите, пожалуйста, как это исправить. Гистограмма с накоплением не подойдет, т.к мне не нужна ось которая имеет суммированные значения столбцов
Потеря связей при копировании папки
Пользователь
Сообщений: Регистрация: 09.09.2022
04.07.2023 15:25:26
Добрый день!
У меня лежат папки с файлами, имеющие такой путь O:\СИП\ПК\2023\(далее идут папки январь, февраль и т.д) В данной папке с наименованием месяца находится много файлов и других папок, когда я копирую, к примеру, папку июнь и переименовываю ее на июль, то в половине файлов связи меняются на "июль", а в остальной половине файлов связи остаются старые, т.е июньские.
Вопрос: Почему так происходит? Можно ли как-то более грамотно получить новую переименованную папку с копированными из старой папки файлами, с автоматически обновленными связями.
Структура папок одинаковая, все файлы имеют одинаковые наименования
Нарастающий итог с несколькими условиями
Пользователь
Сообщений: Регистрация: 09.09.2022
04.07.2023 12:41:54
Добрый день!
У меня есть такая формула, считающая нарастающий итог(На Лист1 в ячейках D1 и D2 выбираем с какого по какой месяц должен быть нарастающий итог) =СУММПРОИЗВ((ШАБЛОН!$F$1:$T$1=ИНДЕКС($U$3:$U$14;ПОИСКПОЗ($F$1;$U$3:$U$14;)):ИНДЕКС($U$3:$U$14;ПОИСКПОЗ($F$2;$U$3:$U$14;)))*ШАБЛОН!$F3:$T3)
Я хочу добавить к этой формуле проверку по нескольким условиям(столбцам)
Пробую сделать таким способом, но получаю ошибки #Н/Д или Знач =СУММПРОИЗВ((ШАБЛОН!$D$1:$R$1=ИНДЕКС($T$3:$T$14;ПОИСКПОЗ($E$1;$T$3:$T$14;)):ИНДЕКС($T$3:$T$14;ПОИСКПОЗ($E$2;$T$3:$T$14;)))*(ШАБЛОН!$B$2:$B$3000=Лист1!$B3)*(ШАБЛОН!$A$2:$A$3000=Лист1!$A3);ШАБЛОН!$D2:$R3000)
Подскажите, пожалуйста, как это можно реализовать? В чем моя ошибка? Т.е моя конечная цель, это если произошли какие-то изменения в столбцах A/B/C, расчет должен подстраиваться под эти изменения, в том виде, в котором сделано у меня сейчас, задается явная строка $F3:$T3, хотелось бы задать сразу весь массив значений и выборку по столбцам
Объединить два работающих макроса по вставке формул
Пользователь
Сообщений: Регистрация: 09.09.2022
09.03.2023 08:31:55
Добрый день! Есть два работающих макроса по вставке формулы в книгу excel. Подскажите, пожалуйста, как можно их объединить в один
Макрос 1
Код
Public fso As Object
Sub ВставитьФормулу()
Set fso = CreateObject("Scripting.FileSystemObject")
Dim fullFrom As Variant
fullFrom = ShowFileDialog("Выберите файл источник", False)
If IsEmpty(fullFrom) Then Exit Sub
Dim fullTarg As Variant
fullTarg = ShowFileDialog("Выберите файлы приёмники", True)
If IsEmpty(fullTarg) Then Exit Sub
Dim wbFrom As Workbook
Set wbFrom = GetWb(fullFrom(1))
Dim vFull As Variant
For Each vFull In fullTarg
FillFormulasInWorkbook vFull, wbFrom
Next
wbFrom.Close False
End Sub
Private Sub FillFormulasInWorkbook(ByVal sFull As String, wbFrom As Workbook)
Dim rr As Range
Dim sh As Worksheet
Dim wb As Workbook
Set wb = GetWb(sFull)
If Not wb Is Nothing Then
Dim ss As String
Dim vMonth As Variant
For Each vMonth In Array("Январь", "Февраль", "Март", "Апрель", "Май", "Июнь", "Июль", "Август", "Сентябрь", "Октябрь", "Ноябрь", "Декабрь")
Set sh = wb.Sheets(vMonth)
Set rr = sh.Range("G11:G15,G17:G20,G22,G24:G27,G29:G36,G38:G40,G42:G50,G52:G53,G55:G56,G59:G68,I11:I15,I17:I20,I22,I24:I27,I29:I36,I38:I40,I42:I50,I52:I53,I55:I56,I59:I68")
ss = "=ЕСЛИОШИБКА(ИНДЕКС('[" & wbFrom.Name & "]Январь'!$G$11:$J$68;ПОИСКПОЗ($D11;'[" & wbFrom.Name & "]Январь'!$D$11:$D$68;0);ПОИСКПОЗ(G$9;'[" & wbFrom.Name & "]Январь'!$G$9:$J$9;0));" & """""" & ")"
ss = Replace(ss, "Январь", vMonth)
rr.FormulaLocal = ss
Next
wb.RemovePersonalInformation = 0
wb.Close True
End If
End Sub
Private Function GetWb(ByVal sFull As String) As Workbook
Dim sName As String
sName = fso.GetFileName(sFull)
Dim wb As Workbook
On Error Resume Next
Set wb = Workbooks(sName)
On Error GoTo 0
If Not wb Is Nothing Then
If wb.FullName <> sFull Or wb.ReadOnly Then
wb.Close False
Set wb = Nothing
End If
End If
If wb Is Nothing Then
Set wb = Workbooks.Open(sFull, False, False)
End If
Set GetWb = wb
End Function
Private Function ShowFileDialog(sTitle As String, bAllowMultiSelect As Boolean) As Variant
Dim rInitialFileName As Range
On Error Resume Next
Set rInitialFileName = ThisWorkbook.Names("Файл").RefersToRange
Dim oFD As FileDialog
Dim x, lf As Long
'назначаем переменной ссылку на экземпляр диалога
Set oFD = Application.FileDialog(msoFileDialogFilePicker)
With oFD 'используем короткое обращение к объекту
'так же можно без oFD
'With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = bAllowMultiSelect
.Title = sTitle
.Filters.Clear 'очищаем установленные ранее типы файлов
.Filters.Add "Excel files", "*.xls*", 1 'устанавливаем возможность выбора только файлов Excel
'.Filters.Add "Text files", "*.txt", 2 'добавляем возможность выбора текстовых файлов
.FilterIndex = 1 'устанавливаем тип файлов по умолчанию - Text files(Текстовые файлы)
.InitialFileName = rInitialFileName.Value
.InitialView = msoFileDialogViewDetails 'вид диалогового окна(доступно 9 вариантов)
If .Show = 0 Then Exit Function 'показывает диалог
Dim arr As Variant
'цикл по коллекции выбранных в диалоге файлов
For lf = 1 To .SelectedItems.Count
If Left(fso.GetFileName(.SelectedItems(lf)), 2) <> "~$" Then
If IsEmpty(arr) Then
ReDim arr(1 To 1)
If Not rInitialFileName Is Nothing Then rInitialFileName.Value = .SelectedItems(lf)
Else
ReDim Preserve arr(1 To UBound(arr) + 1)
End If
arr(UBound(arr)) = .SelectedItems(lf) 'считываем полный путь к файлу
End If
Next
ShowFileDialog = arr
End With
End Function
Макрос 2. Вставляет данную формулу на другие листы и ячейки.
Код
Public fso As Object
Sub ВставитьФормулу()
Set fso = CreateObject("Scripting.FileSystemObject")
Dim fullFrom As Variant
fullFrom = ShowFileDialog("Выберите файл источник", False)
If IsEmpty(fullFrom) Then Exit Sub
Dim fullTarg As Variant
fullTarg = ShowFileDialog("Выберите файлы приёмники", True)
If IsEmpty(fullTarg) Then Exit Sub
Dim wbFrom As Workbook
Set wbFrom = GetWb(fullFrom(1))
Dim vFull As Variant
For Each vFull In fullTarg
FillFormulasInWorkbook vFull, wbFrom
Next
wbFrom.Close False
End Sub
Private Sub FillFormulasInWorkbook(ByVal sFull As String, wbFrom As Workbook)
Dim rr As Range
Dim sh As Worksheet
Dim wb As Workbook
Set wb = GetWb(sFull)
If Not wb Is Nothing Then
Dim ss As String
Dim vMonth As Variant
For Each vMonth In Array("I квартал", "II квартал", "III квартал", "IV квартал", "Год")
Set sh = wb.Sheets(vMonth)
Set rr = sh.Range("G30:J30,G65:J68")
ss = "=ЕСЛИОШИБКА(ИНДЕКС('[" & wbFrom.Name & "]I квартал'!$G$11:$J$68;ПОИСКПОЗ($D30;'[" & wbFrom.Name & "]I квартал'!$D$11:$D$68;0);ПОИСКПОЗ(G$9;'[" & wbFrom.Name & "]I квартал'!$G$9:$J$9;0));" & """""" & ")"
ss = Replace(ss, "I квартал", vMonth)
rr.FormulaLocal = ss
Next
wb.RemovePersonalInformation = 0
wb.Close True
End If
End Sub
Private Function GetWb(ByVal sFull As String) As Workbook
Dim sName As String
sName = fso.GetFileName(sFull)
Dim wb As Workbook
On Error Resume Next
Set wb = Workbooks(sName)
On Error GoTo 0
If Not wb Is Nothing Then
If wb.FullName <> sFull Or wb.ReadOnly Then
wb.Close False
Set wb = Nothing
End If
End If
If wb Is Nothing Then
Set wb = Workbooks.Open(sFull, False, False)
End If
Set GetWb = wb
End Function
Private Function ShowFileDialog(sTitle As String, bAllowMultiSelect As Boolean) As Variant
Dim rInitialFileName As Range
On Error Resume Next
Set rInitialFileName = ThisWorkbook.Names("Файл").RefersToRange
Dim oFD As FileDialog
Dim x, lf As Long
'назначаем переменной ссылку на экземпляр диалога
Set oFD = Application.FileDialog(msoFileDialogFilePicker)
With oFD 'используем короткое обращение к объекту
'так же можно без oFD
'With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = bAllowMultiSelect
.Title = sTitle
.Filters.Clear 'очищаем установленные ранее типы файлов
.Filters.Add "Excel files", "*.xls*", 1 'устанавливаем возможность выбора только файлов Excel
'.Filters.Add "Text files", "*.txt", 2 'добавляем возможность выбора текстовых файлов
.FilterIndex = 1 'устанавливаем тип файлов по умолчанию - Text files(Текстовые файлы)
.InitialFileName = rInitialFileName.Value
.InitialView = msoFileDialogViewDetails 'вид диалогового окна(доступно 9 вариантов)
If .Show = 0 Then Exit Function 'показывает диалог
Dim arr As Variant
'цикл по коллекции выбранных в диалоге файлов
For lf = 1 To .SelectedItems.Count
If Left(fso.GetFileName(.SelectedItems(lf)), 2) <> "~$" Then
If IsEmpty(arr) Then
ReDim arr(1 To 1)
If Not rInitialFileName Is Nothing Then rInitialFileName.Value = .SelectedItems(lf)
Else
ReDim Preserve arr(1 To UBound(arr) + 1)
End If
arr(UBound(arr)) = .SelectedItems(lf) 'считываем полный путь к файлу
End If
Next
ShowFileDialog = arr
End With
End Function
Изменено: - 09.03.2023 08:34:18
Добавить в макрос копирование ячеек на другие листы.
Пользователь
Сообщений: Регистрация: 09.09.2022
09.03.2023 07:09:05
Добрый день! Сейчас у меня есть такой макрос, вставляющий формулу на нужные мне листы из одной книги в другую.
Хочу добавить в этот макрос аналогичную вставку значений на листы "I квартал", "II квартал", "III квартал", "IV квартал", "Год" в ячейки "G30:J30,G65:J68"
Но что-то не получается у меня, подскажите пожалуйста как правильно это сделать?
P.S Первым комментарием выложу код моей попытки
Код
Public fso As Object
Sub ВставитьФормулу()
Set fso = CreateObject("Scripting.FileSystemObject")
Dim fullFrom As Variant
fullFrom = ShowFileDialog("Выберите файл источник", False)
If IsEmpty(fullFrom) Then Exit Sub
Dim fullTarg As Variant
fullTarg = ShowFileDialog("Выберите файлы приёмники", True)
If IsEmpty(fullTarg) Then Exit Sub
Dim wbFrom As Workbook
Set wbFrom = GetWb(fullFrom(1))
Dim vFull As Variant
For Each vFull In fullTarg
FillFormulasInWorkbook vFull, wbFrom
Next
wbFrom.Close False
End Sub
Private Sub FillFormulasInWorkbook(ByVal sFull As String, wbFrom As Workbook)
Dim rr As Range
Dim sh As Worksheet
Dim wb As Workbook
Set wb = GetWb(sFull)
If Not wb Is Nothing Then
Dim ss As String
Dim vMonth As Variant
For Each vMonth In Array("Январь", "Февраль", "Март", "Апрель", "Май", "Июнь", "Июль", "Август", "Сентябрь", "Октябрь", "Ноябрь", "Декабрь")
Set sh = wb.Sheets(vMonth)
Set rr = sh.Range("G11:G15,G17:G20,G22,G24:G27,G29:G36,G38:G40,G42:G50,G52:G53,G55:G56,G59:G68,I11:I15,I17:I20,I22,I24:I27,I29:I36,I38:I40,I42:I50,I52:I53,I55:I56,I59:I68")
ss = "=ЕСЛИОШИБКА(ИНДЕКС('[" & wbFrom.Name & "]Январь'!$G$11:$J$68;ПОИСКПОЗ($D11;'[" & wbFrom.Name & "]Январь'!$D$11:$D$68;0);ПОИСКПОЗ(G$9;'[" & wbFrom.Name & "]Январь'!$G$9:$J$9;0));" & """""" & ")"
ss = Replace(ss, "Январь", vMonth)
rr.FormulaLocal = ss
Next
wb.RemovePersonalInformation = 0
wb.Close True
End If
End Sub
Private Function GetWb(ByVal sFull As String) As Workbook
Dim sName As String
sName = fso.GetFileName(sFull)
Dim wb As Workbook
On Error Resume Next
Set wb = Workbooks(sName)
On Error GoTo 0
If Not wb Is Nothing Then
If wb.FullName <> sFull Or wb.ReadOnly Then
wb.Close False
Set wb = Nothing
End If
End If
If wb Is Nothing Then
Set wb = Workbooks.Open(sFull, False, False)
End If
Set GetWb = wb
End Function
Private Function ShowFileDialog(sTitle As String, bAllowMultiSelect As Boolean) As Variant
Dim rInitialFileName As Range
On Error Resume Next
Set rInitialFileName = ThisWorkbook.Names("Файл").RefersToRange
Dim oFD As FileDialog
Dim x, lf As Long
'назначаем переменной ссылку на экземпляр диалога
Set oFD = Application.FileDialog(msoFileDialogFilePicker)
With oFD 'используем короткое обращение к объекту
'так же можно без oFD
'With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = bAllowMultiSelect
.Title = sTitle
.Filters.Clear 'очищаем установленные ранее типы файлов
.Filters.Add "Excel files", "*.xls*", 1 'устанавливаем возможность выбора только файлов Excel
'.Filters.Add "Text files", "*.txt", 2 'добавляем возможность выбора текстовых файлов
.FilterIndex = 1 'устанавливаем тип файлов по умолчанию - Text files(Текстовые файлы)
.InitialFileName = rInitialFileName.Value
.InitialView = msoFileDialogViewDetails 'вид диалогового окна(доступно 9 вариантов)
If .Show = 0 Then Exit Function 'показывает диалог
Dim arr As Variant
'цикл по коллекции выбранных в диалоге файлов
For lf = 1 To .SelectedItems.Count
If Left(fso.GetFileName(.SelectedItems(lf)), 2) <> "~$" Then
If IsEmpty(arr) Then
ReDim arr(1 To 1)
If Not rInitialFileName Is Nothing Then rInitialFileName.Value = .SelectedItems(lf)
Else
ReDim Preserve arr(1 To UBound(arr) + 1)
End If
arr(UBound(arr)) = .SelectedItems(lf) 'считываем полный путь к файлу
End If
Next
ShowFileDialog = arr
End With
End Function
Изменить макрос по вставке ячеек из другой книги.
Пользователь
Сообщений: Регистрация: 09.09.2022
25.01.2023 12:13:51
Добрый день! Есть такой макрос, вставляющий формулу в определенные ячейки одного файла, используя связь с другим файлом.(оба файлы имели одинаковые наименования листов, да и вообще всю структуру)
Сейчас нужно сделать тоже самое(вставить формулу имеющую связь с другим файлом), только иметь возможность выбрать лист откуда будут браться данные из файла источника.
Файл приемник - тот же самый формат и структура Файл источник - другой формат, другие наименования листов. Все данные будут браться с одного листа (к примеру, лист с именем "ТЭЦ", ну а сама формула вставлятся во все листы файла приемника как и раньше, тут без изменений)
Подскажите пожалуйста как изменить макрос. Заранее большое спасибо!
Код
Public fso As Object
Sub ВставитьФормулу()
Set fso = CreateObject("Scripting.FileSystemObject")
Dim fullFrom As Variant
fullFrom = ShowFileDialog("Выберите файл источник", False)
If IsEmpty(fullFrom) Then Exit Sub
Dim fullTarg As Variant
fullTarg = ShowFileDialog("Выберите файлы приёмники", True)
If IsEmpty(fullTarg) Then Exit Sub
Dim wbFrom As Workbook
Set wbFrom = GetWb(fullFrom(1))
Dim vFull As Variant
For Each vFull In fullTarg
FillFormulasInWorkbook vFull, wbFrom
Next
wbFrom.Close False
End Sub
Private Sub FillFormulasInWorkbook(ByVal sFull As String, wbFrom As Workbook)
Dim rr As Range
Dim sh As Worksheet
Dim wb As Workbook
Set wb = GetWb(sFull)
If Not wb Is Nothing Then
Dim ss As String
Dim vMonth As Variant
For Each vMonth In Array("Январь", "Февраль", "Март", "Апрель", "Май", "Июнь", "Июль", "Август", "Сентябрь", "Октябрь", "Ноябрь", "Декабрь")
Set sh = wb.Sheets(vMonth)
Set rr = sh.Range("G11:G15,G17:G20,G22,G24:G27,G29:G36,G38:G40,G42:G50,G52:G53,G55:G56,G59:G68,I11:I15,I17:I20,I22,I24:I27,I29:I36,I38:I40,I42:I50,I52:I53,I55:I56,I59:I68")
ss = "=ЕСЛИОШИБКА(ИНДЕКС('[" & wbFrom.Name & "]Январь'!$G$11:$J$68;ПОИСКПОЗ($E11;'[" & wbFrom.Name & "]Январь'!$E$11:$E$68;0);ПОИСКПОЗ(G$9;'[" & wbFrom.Name & "]Январь'!$G$9:$J$9;0));" & """""" & ")"
ss = Replace(ss, "Январь", vMonth)
rr.FormulaLocal = ss
Next
wb.RemovePersonalInformation = 0
wb.Close True
End If
End Sub
Private Function GetWb(ByVal sFull As String) As Workbook
Dim sName As String
sName = fso.GetFileName(sFull)
Dim wb As Workbook
On Error Resume Next
Set wb = Workbooks(sName)
On Error GoTo 0
If Not wb Is Nothing Then
If wb.FullName <> sFull Or wb.ReadOnly Then
wb.Close False
Set wb = Nothing
End If
End If
If wb Is Nothing Then
Set wb = Workbooks.Open(sFull, False, False)
End If
Set GetWb = wb
End Function
Private Function ShowFileDialog(sTitle As String, bAllowMultiSelect As Boolean) As Variant
Dim rInitialFileName As Range
On Error Resume Next
Set rInitialFileName = ThisWorkbook.Names("Файл").RefersToRange
Dim oFD As FileDialog
Dim x, lf As Long
'назначаем переменной ссылку на экземпляр диалога
Set oFD = Application.FileDialog(msoFileDialogFilePicker)
With oFD 'используем короткое обращение к объекту
'так же можно без oFD
'With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = bAllowMultiSelect
.Title = sTitle
.Filters.Clear 'очищаем установленные ранее типы файлов
.Filters.Add "Excel files", "*.xls*", 1 'устанавливаем возможность выбора только файлов Excel
'.Filters.Add "Text files", "*.txt", 2 'добавляем возможность выбора текстовых файлов
.FilterIndex = 1 'устанавливаем тип файлов по умолчанию - Text files(Текстовые файлы)
.InitialFileName = rInitialFileName.Value
.InitialView = msoFileDialogViewDetails 'вид диалогового окна(доступно 9 вариантов)
If .Show = 0 Then Exit Function 'показывает диалог
Dim arr As Variant
'цикл по коллекции выбранных в диалоге файлов
For lf = 1 To .SelectedItems.Count
If Left(fso.GetFileName(.SelectedItems(lf)), 2) <> "~$" Then
If IsEmpty(arr) Then
ReDim arr(1 To 1)
If Not rInitialFileName Is Nothing Then rInitialFileName.Value = .SelectedItems(lf)
Else
ReDim Preserve arr(1 To UBound(arr) + 1)
End If
arr(UBound(arr)) = .SelectedItems(lf) 'считываем полный путь к файлу
End If
Next
ShowFileDialog = arr
End With
End Function
Изменено: - 25.01.2023 12:14:48
Просмотр изменений в excel.
Пользователь
Сообщений: Регистрация: 09.09.2022
24.01.2023 09:03:04
Добрый день! Сделал книгу excel общей и выбрал во вкладке рецензирование/Исправления/Выделить исправления.
Исправления ячеек где вставлены обычные значения он показывает, но то что считается формулой не показывает, можно ли как-то видеть прошлые результаты рассчитанные формулой?
На листе чистая выработка почти все ячейки имеют либо ссылку связями, либо формулу(которая пересчитывается каждый раз при изменении исходных данных(скорость ветра и часы простоя)
Вот нужно видеть именно пересчет этих формул, т.е к примеру, была скорость ветра в ВЭС 1 = 6.5 а Wпрогноз = 12810, изменили скорость ветра на 10, Wпрогноз стал = 43372(формула сама все посчитала, я меняю только значения скорости ветра и часов простоя в исходных данных, больше абсолютно ничего не трогаю)
Хочется увидеть: Навели курсор на ячейку Wпрогноз и показывается комментарием "прошлое значение: 12810"
P.S рассматриваю все возможные варианты, если намного проще реализовать это в другом виде Для скорости работы можно сделать только для ячеек Wпрогноз, КИУМ, скорость ветра, остальные не нужны
Цель: видеть прошлый результат расчетов и нынешний
Изменено: - 25.01.2023 09:01:31
Парсинг данных с сайта. Power query
Пользователь
Сообщений: Регистрация: 09.09.2022
20.01.2023 05:04:16
Добрый день! пытаюсь импортировать данные с сайта яндекс погоды
Сам power query никаких таблиц не видит, поэтому пробовал обработать данные в текстовом виде. Но вся информация за 30 дней находится в одной строке, из-за этого не получается вытащить.
Помогите пожалуйста, нужно достать из кода данные значения: День, Дневная температура, ночная температура.(ну и чтоб в запросе можно было менять выгрузку помесячно(хотя бы просто менять в ссылке january на february и т.д)
Изменено: - 20.01.2023 05:08:22
Power query выгружает только первые 1000 строк
Пользователь
Сообщений: Регистрация: 09.09.2022
18.01.2023 09:50:43
Добрый день! Делаю выгрузку архива погоды, но выгружаются только первые 1000 строк, пробовал решить проблему так
Наведите курсор мыши ЗА пределы сводной таблицы
Щелкните меню "ДАННЫЕ"
Щелкните Соединения
В диалоговом окне Подключения к рабочей книге нажмите "ThisWorkbookDataModel"
Нажмите Свойства. На вкладке использование “Максимальное количество извлекаемых записей”
но все равно выгружает только первые 1000 строк, подскажите пожалуйста как снять данное ограничение
Заменить формулу в готовом макросе
Пользователь
Сообщений: Регистрация: 09.09.2022
18.01.2023 07:53:34
Добрый день! Есть рабочий макрос вставляющий формулу(Спасибо ), которая копирует данные из одного файла в другой.
Код
Public fso As Object
Sub ВставитьФормулу()
Set fso = CreateObject("Scripting.FileSystemObject")
Dim fullFrom As Variant
fullFrom = ShowFileDialog("Выберите файл источник", False)
If IsEmpty(fullFrom) Then Exit Sub
Dim fullTarg As Variant
fullTarg = ShowFileDialog("Выберите файлы приёмники", True)
If IsEmpty(fullTarg) Then Exit Sub
Dim wbFrom As Workbook
Set wbFrom = GetWb(fullFrom(1))
Dim vFull As Variant
For Each vFull In fullTarg
FillFormulasInWorkbook vFull, wbFrom
Next
wbFrom.Close False
End Sub
Private Sub FillFormulasInWorkbook(ByVal sFull As String, wbFrom As Workbook)
Dim rr As Range
Dim sh As Worksheet
Dim wb As Workbook
Set wb = GetWb(sFull)
If Not wb Is Nothing Then
Dim ss As String
Dim vMonth As Variant
For Each vMonth In Array("Январь", "Февраль", "Март", "Апрель", "Май", "Июнь", "Июль", "Август", "Сентябрь", "Октябрь", "Ноябрь", "Декабрь")
Set sh = wb.Sheets(vMonth)
Set rr = sh.Range("G11:J15,G17:J20,J21,G22:J22,J23,G24:J27,G29:J36,G38:J40,G42:J50,G52:J53,G55:J56,G59:J68")
ss = "=СУММПРОИЗВ(('[" & wbFrom.Name & "]Январь'!$E$11:$E$68=$E11)*('[" & wbFrom.Name & "]Январь'!$G$9:$J$9=G$9);'[" & wbFrom.Name & "]Январь'!$G$11:$J$68)"
ss = Replace(ss, "Январь", vMonth)
rr.FormulaLocal = ss
Next
wb.RemovePersonalInformation = 0
wb.Close True
End If
End Sub
Private Function GetWb(ByVal sFull As String) As Workbook
Dim sName As String
sName = fso.GetFileName(sFull)
Dim wb As Workbook
On Error Resume Next
Set wb = Workbooks(sName)
On Error GoTo 0
If Not wb Is Nothing Then
If wb.FullName <> sFull Or wb.ReadOnly Then
wb.Close False
Set wb = Nothing
End If
End If
If wb Is Nothing Then
Set wb = Workbooks.Open(sFull, False, False)
End If
Set GetWb = wb
End Function
Private Function ShowFileDialog(sTitle As String, bAllowMultiSelect As Boolean) As Variant
Dim rInitialFileName As Range
On Error Resume Next
Set rInitialFileName = ThisWorkbook.Names("Файл").RefersToRange
Dim oFD As FileDialog
Dim x, lf As Long
'назначаем переменной ссылку на экземпляр диалога
Set oFD = Application.FileDialog(msoFileDialogFilePicker)
With oFD 'используем короткое обращение к объекту
'так же можно без oFD
'With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = bAllowMultiSelect
.Title = sTitle
.Filters.Clear 'очищаем установленные ранее типы файлов
.Filters.Add "Excel files", "*.xls*", 1 'устанавливаем возможность выбора только файлов Excel
'.Filters.Add "Text files", "*.txt", 2 'добавляем возможность выбора текстовых файлов
.FilterIndex = 1 'устанавливаем тип файлов по умолчанию - Text files(Текстовые файлы)
.InitialFileName = rInitialFileName.Value
.InitialView = msoFileDialogViewDetails 'вид диалогового окна(доступно 9 вариантов)
If .Show = 0 Then Exit Function 'показывает диалог
Dim arr As Variant
'цикл по коллекции выбранных в диалоге файлов
For lf = 1 To .SelectedItems.Count
If Left(fso.GetFileName(.SelectedItems(lf)), 2) <> "~$" Then
If IsEmpty(arr) Then
ReDim arr(1 To 1)
If Not rInitialFileName Is Nothing Then rInitialFileName.Value = .SelectedItems(lf)
Else
ReDim Preserve arr(1 To UBound(arr) + 1)
End If
arr(UBound(arr)) = .SelectedItems(lf) 'считываем полный путь к файлу
End If
Next
ShowFileDialog = arr
End With
End Function
По окончанию работы макроса почему-то остается открытым файл источник(с которого копируются данные) и вылезает ошибка "Run-time error 1004: Application-defined or object-defined error", но в целом все формулы вставляются как нужно и на все листы которые нужны, возможно ошибка вылезает из-за того, что в файле в который вставляются и откуда берутся данные много ограничений(запрет на исправление многих ячеек, защищенные листы, режим разработчика под паролем и т.д)
Вопрос: Оказалось что формула СУММПРОИЗВ работает некорректно для моих целей( дублированные наименования складываются, изначально не заметил что есть дублированные строки), поэтому заменяю формулу в макросе на
Больше ничего в макросе не трогал, т.е только заменил формулу в данной строке, но теперь вылазит ошибка 400 и макрос не срабатывает, подскажите что я делаю не так? может со скобками ошибся, но вроде все варианты уже попробовал и делал по аналогии с рабочим вариантом. Работоспособность самой формулы проверил, если вручную вставлять в ячейки, то все данные подгружаются правильно
Изменено: - 18.01.2023 07:56:50
Учесть в формуле наименование листа
Пользователь
Сообщений: Регистрация: 09.09.2022
17.01.2023 12:28:08
Добрый день! Хотелось бы чтоб данная формула учитывала наименование листа и часть формулы, где "Январь" изменялась взависимости от наименования месяца
=СУММПРОИЗВ(('C:\Users\antrodmi\Desktop\Новая папка\шаблон\[Отсюда скинуть.xlsx]Январь'!$E$11:$E$68=$E11)*('C:\Users\antrodmi\Desktop\Новая папка\шаблон\[Отсюда скинуть.xlsx]Январь'!$G$9:$J$9=G$9);'C:\Users\antrodmi\Desktop\Новая папка\шаблон\[Отсюда скинуть.xlsx]Январь'!$G$11:$J$68) - сама формула
=ПСТР(ЯЧЕЙКА("имяфайла";A1);ПОИСК("]";ЯЧЕЙКА("имяфайла";A1))+1;99) - Формула вытаскивающая имя листа
По отдельности работают, но при объединении почему-то выдает ошибку.
Макрос на вставку значений в определенные листы и ячейки
Пользователь
Сообщений: Регистрация: 09.09.2022
17.01.2023 11:21:05
Добрый день! Написал формулу, которая из нужных ячеек вставляет данные из одного файла в другой.
Нужно чтоб макрос вставлял данную формулу во все листы с наименованием месяца(январь-декабрь, только в эти листы) и в ячейки выделенные желтым цветом в файлах(которые не выделены заблокированы в оригинальных файлах), а именно G11:J15;G17:20;J21;G22:J22;J23;G24:J27;G29:J36;G38:J40;G42:J50;G52:J53;G55:J56;G59:J68
Январь'! - нужно чтоб данная часть формулы(наименование листа) откуда берутся данные, менялась в зависимости от имени листа, т.е для листа февраль - Январь менялся на Февраль и т.д
Макрос должен запускаться из отдельной книги excel(т.е необходимо создать третий файл), т.к в оригинальном файле куда нужно будет вставлять информацию режим разработчика под паролем.
Подскажите пожалуйста как это реализовать.
Изменено: - 17.01.2023 11:27:36
Импорт таблицы c сайта. Power Query
Пользователь
Сообщений: Регистрация: 09.09.2022
13.01.2023 11:57:13
Добрый день! На листе Гисметео импортировал таблицу с данного сайта , меняя в запросе power query данную часть "/2022/1/" в excel загружаются температурные данные за разные года и месяцы.
Подскажите, можно ли сделать чтоб эти данные выгружались не за 1 месяц, как сейчас, а можно было задать промежуток, к примеру "c 08.2022 по 01.2023" и т.п
Если это реализуемо, подскажите пожалуйста как нужно исправить мой запрос power query.
Импорт прогноза погоды и погоды прошлых дней.
Пользователь
Сообщений: Регистрация: 09.09.2022
11.01.2023 14:30:21
Добрый день! Нужно импортировать данные прогноза погоды и температуры прошлых дней в excel. Уже сталкивался с подобной задачей, где нужен был импорт данных, помог такой код в power query, где в строке "сегодня =" я изменял начальную дату и количество суток по которым мне нужна информация.
Код
let
сегодня = let a = Date.From("01.10.2022"), b= List.Dates(Date.From("01.10.2022"),31,#duration(1,0,0,0)), c = List.Select(b, each Date.Month(_) = Date.Month(a)) in c,
Custom1 = Table.Combine( List.Transform(сегодня, each let a=Date.ToText(_, "yyyy-MM-dd"), Source = Text.Combine(Lines.FromBinary(Web.Contents("https://www.so-ups.ru/functioning/ups/indicators/ees-gen-consump-hour/?tx_mscdugraph_pi[viewDate]=&a...; & a ))),
Custom2 = {Text.Split(Text.BetweenDelimiters(Source, "data-datax=""", """"),","), Text.Split(Text.BetweenDelimiters(Source, "data-datay1=""", """"),","),Text.Split(Text.BetweenDelimiters(Source, "data-datay=""", """"),",")}
in Table.FromColumns(Custom2, {"Дата","Мощность генерации, МВт","Мощность потребления, МВт"}))),
#"Измененный тип" = Table.TransformColumnTypes(Custom1,{{"Мощность генерации, МВт", Int64.Type}, {"Мощность потребления, МВт", Int64.Type}})
in
#"Измененный тип"
Подскажите, как сделать подобное с сайта прогноза погоды(можно использовать любой, к примеру гисметео) для Челябинска. Т.е цель такая, выбираем период по которому нужны данные и получаем информацию(дата, погода день/ночь, средняя суточная погода(в зависимости от данных которые будут на сайте)) - почасовая точно не нужна, в идеале сразу вынести среднее значение по суткам, но можно отдельно на день/ночь, как на большинстве сайтов.
Если же сайты связанные с погодой и прогнозом не хранят данные прошлых месяцев, то хотя бы по имеющимся данным.
P.S Нашел, что погода маил.ру хранит данные и прошлых лет, и последующих
Подскажите, пожалуйста, как написать запрос power query, чтоб изменяя даты в запросе можно было увидеть изменение данных в excel. К сожалению, данный сайт имеет не табличный вид данных
Добрый день! Сейчас имеется готовое решение в файле"Р06" (спасибо tutochkin), но не могу разобраться какие изменения нужно внести в макросы для оцифровки аналогичных графиков.
Какие изменения были внесены в файл "Р08": Подставил картинку с графиками на задний фон. Задал оси в соответствии с картинкой которую нужно оцифровать. Заменил в макросе точки на оцифрованные мной для Р08
х от 40 до 230 и у от 1100 до 2500. Нужные нам линии +- приняли форму графика, но не могу разобраться как изменить ширину данных линий.
- почитал данную статью, а так же текст по данным темам на пикабу( к сожалению, скриншоты там не подгружаются, видимо, из-за того что статьи довольно старые)
Пожалуйста, подскажите, что еще нужно изменять помимо осей. Большая часть макросов в моем файле "P06" и в статьях абсолютно одинаковые.
Буду очень благодарен за объяснение как из файла P06 получить такую же оцифровку в файле P08.
Изменено: - 22.12.2022 14:55:27
Сместить ячейку на определенное кол-во ячеек вправо
Пользователь
Сообщений: Регистрация: 09.09.2022
20.12.2022 12:07:56
Добрый день! подскажите, пожалуйста, формулу по смещению ячейки вправо на нужное кол-во ячеек.
В строке 3 ячейка BB3 = 100 В строке 4 пустые значения, тут нужно написать формулу, которая должна смотреть значения выше(третьей строки), если ячейка выше = 0, пишем ноль, если ячейка = числу, то напишем это значение тремя ячейками правее( в строке 3 есть 2 числа, правее нужно переносить на столько, сколько нулей находится между этими значениями)
Можно макросом или формулой решить, как удобнее будет.
Смещение данных в строке в зависимости от нескольких условий
Пользователь
Сообщений: Регистрация: 09.09.2022
20.12.2022 10:00:12
Добрый день! На листе "ПП без учета ХР" в декабре 2027г. и в январе 2028г. стоят две инспекции = 120 и 150. На втором листе " ПП с учетом ХР" нужно сравнить часы наработки(в некоторых месяцах значения могут быть равны 0 или меньше чем на листе "ПП без учета ХР") с первым листом и в зависимости от этого сдвинуть инспекцию на столько месяцев, пока суммарное кол-во часов на листе " ПП с учетом ХР" не будет >= "ПП без учета ХР"
Сейчас я написал такую формулу:
=ЕСЛИ(И(СУММ('ПП с учетом ХР'!$B$2:BT2)>=СУММ('ПП без учета ХР'!$B$2:$BM$2);СЧЁТЕСЛИ($B$3:BT3;'ПП без учета ХР'!$CE$3)=0);'ПП без учета ХР'!$CE$3;"")
СУММ('ПП без учета ХР'!$B$2:$BM$2) - фиксированное кол-во часов до инспекции
СЧЁТЕСЛИ($B$3:BT3;'ПП без учета ХР'!$CE$3)=0) - проверка, чтоб при сдвиге инспекции не было дублирований в последующих ячейках.
Вопрос: Данная формула учитывает данные и сдвигает только одну инспекцию(декабря 2027г.), как мне сделать чтоб учитывались и сдвигались сразу две инспекции? Вторая инспекция должна сместиться на такое же кол-во месяцев как и первая, но от своей позиции в ячейке.
Решать можно хоть макросом, хоть формулой.
Заранее большое спасибо!
Изменено: - 20.12.2022 11:24:15
Протягивание формулы с определенным шагом
Пользователь
Сообщений: Регистрация: 09.09.2022
15.12.2022 11:21:32
Добрый день! В файле есть объединенные ячейки, как в таких случаях протягивать формулу с шагом?
Т.е в моем файле объединенная ячейка состоит из четырех других, поэтому протягивая формулу нужно увидеть не "=F11, F12, F13 и т.д", а "F11, F15,F19"
Подскажите, пожалуйста, как формулой добиться такого результата.
Добрый день! Сейчас в файле используется сложная формула расчета интерполяцией(Power[kW] - ячейки подсвеченные зеленым в файле), но формула интерполяции, в том числе, еще учитывает марку оборудования.(весь расчет исходя из синей таблицы выше)
Моя проблема в том, что когда я делаю посуточный расчет используя данную формулу, т.е делаю расчет на 365 дней для большого кол-ва агрегатов. Вес файла становится более 10мб и, соответственно, начинает дико лагать, работать становится невозможно.
Подскажите, пожалуйста, может быть можно упростить как-то данную формулу? (можно сделать чтоб формула не учитывала марку агрегата каждый раз, а сделать для каждого агрегата отдельно, но поможет ли?)
Либо может провести какие-то манипуляции с книгой Excel, чтоб данная формула не была такой затратной в плане веса файла и лагов.
Так же пробовал другой способ интерполяции - построить график, вывести уравнение линии и далее вместо Х подставлять нужные нам значение, но полином абсолютно некорректно чертит линию. По линейной фильтрации более менее чертит - но там нельзя вывести уравнение графика.
Решение подойдет любым способом, Макросом (возможно лучший вариант для оптимизации, чтоб файл не тупил из-за вставки сложной формулы в тысячи строк) /формулой / уравнением из графика(если у вас получится сделать это лучше чем у меня).
Заранее большое спасибо за любую помощь.
Суть вкратце: имея два столбца х и y(строки 9-134) написать простую формулу нахождения промежуточных точек.(учитывая что формула будет вставляться в тысячи ячеек), либо написать макрос выполняющий такие возможности.
Добрый день! Есть несколько графиков на одних осях, взятые с pdf картинкой, я их оцифровал в табличные значения.( и начертил в самом excel)
Графики даны для Q0,Q20,Q40...Q160
Вопрос 1) Как начерить и найти табличные значения(х и у) для, к примеру, Q23, Q41 и т.д
Вопрос 2) Можно ли как-то построить такую же штрих линию идущую по краям графиков как на картинке из pdf?
Подскажите пожалуйста, подойдут любые решения, макросы\формулы и т.д
Изменено: - 01.12.2022 14:08:19
Макрос на изменение связей в 1 столбце
Пользователь
Сообщений: Регистрация: 09.09.2022
23.11.2022 09:07:51
Добрый день! Есть макрос изменяющий связи во всей папке с файлами, нужно сделать так, чтоб менял связи только в столбце F. Подскажите пожалуйста как это сделать
Sub MassReplace() Dim aFiles As Variant aFiles = ShowFileDialog() If IsEmpty(aFiles) Then Exit Sub
If form1 = "" Then Exit Sub If form2 = "" Then Exit Sub
Application.EnableEvents = False Dim Application_Calculation As Long Application_Calculation = Application.Calculation Application.Calculation = xlCalculationManual
Dim vFile As Variant For Each vFile In aFiles JobFile vFile, form1, form2 Next
Application.Calculation = Application_Calculation Application.EnableEvents = True End Sub
Private Sub JobFile(ByVal sFull As String, form1 As String, form2 As String) Dim wb As Workbook Set wb = Workbooks.Open(sFull)
Dim sh As Worksheet For Each sh In wb.Worksheets JobSheet sh, form1, form2 Next
wb.Close True End Sub
Private Sub JobSheet(sh As Worksheet, form1 As String, form2 As String) Dim rr As Range On Error Resume Next Set rr = sh.UsedRange.SpecialCells(xlCellTypeFormulas) On Error GoTo 0 If Not rr Is Nothing Then Dim cl As Range For Each cl In rr JobCell cl, form1, form2 Next End If End Sub
Private Sub JobCell(cl As Range, form1 As String, form2 As String) With cl .FormulaR1C1 = Replace(.FormulaR1C1, form1, form2) End With End Sub
Private Function ShowFileDialog() As Variant Dim oFD As FileDialog Dim x, lf As Long 'назначаем переменной ссылку на экземпляр диалога Set oFD = Application.FileDialog(msoFileDialogFilePicker) With oFD 'используем короткое обращение к объекту 'так же можно без oFD 'With Application.FileDialog(msoFileDialogFilePicker) .AllowMultiSelect = True .Title = "Выбрать файлы" 'заголовок окна диалога .Filters.Clear 'очищаем установленные ранее типы файлов .Filters.Add "Excel files", "*.xls*;*.xla*", 1 'устанавливаем возможность выбора только файлов Excel '.Filters.Add "Text files", "*.txt", 2 'добавляем возможность выбора текстовых файлов .FilterIndex = 1 'устанавливаем тип файлов по умолчанию - Text files(Текстовые файлы) .InitialFileName = ThisWorkbook.Path '"С:\Temp\Книга1.xlsx" 'назначаем папку отображения и имя файла по умолчанию .InitialView = msoFileDialogViewDetails 'вид диалогового окна(доступно 9 вариантов) If .Show = 0 Then Exit Function 'показывает диалог Dim arr As Variant ReDim arr(1 To .SelectedItems.Count) 'цикл по коллекции выбранных в диалоге файлов For lf = 1 To .SelectedItems.Count arr(lf) = .SelectedItems(lf) 'считываем полный путь к файлу Next ShowFileDialog = arr End With End Function
Изменено: - 23.11.2022 09:08:37
Формула считающая дни в месяце показывает 2023г високосным. Почему?
Пользователь
Сообщений: Регистрация: 09.09.2022
17.11.2022 13:56:38
Добрый день! Использую формулу ДЕНЬ(КОНМЕСЯЦА(A2;12)), все работает корректно, но нужно учитывать високосные года(2020,2024 и т.д), она же почему то считает 2023г високосным и показывает в феврале 29 дней, как это исправить?
Из-за чего получается погрешность?, Легкая формула, 1 строка решения
Пользователь
Сообщений: Регистрация: 09.09.2022
16.11.2022 08:36:54
Добрый день, столбец Чистая выработка из отчета и Сумма помесячных значений должны совпадать, но получается небольшая погрешность, не могу понять почему.
Строка 144. Формула - (Чистая выработка из отчета * Kветра в месяце(среднее значение за 12 месяцев всегда = 1) * количество дней в месяце * 24(часов в сутках)) / 8760(часы в году)
Т.е по логике вещей формула должна распределить чистую выработку из отчета по 12 месяцам, но почему получается небольшая погрешность?
Макрос на изменение связей в файлах
Пользователь
Сообщений: Регистрация: 09.09.2022
14.11.2022 08:41:13
Добрый день! Есть две папки, в одну папку скидываю 13 файлов всегда с одинаковыми названиями, в другой папке связями забираются с этих файлов значения в нужные ячейки. В следующем месяце все файлы из первой папки удаляются и добавляются новые 13 файлов с такими же названиями.
К сожалению, все связи обрываются и если ставить в "Данные/изменить связи/ не задавать вопрос и обновлять связи автоматически", то это все равно не работает, нужно открывать каждый файл и обновлять связи вручную.
Помогите пожалуйста с написанием макроса, который должен:
1) Открыть все файлы в папке 2) Зайти в изменение связей и обновить все связи от всех источников 3) Сохранить и закрыть все файлы с обновленными связями
Изменено: - 14.11.2022 08:53:40
Изменение связей
Пользователь
Сообщений: Регистрация: 09.09.2022
10.11.2022 13:49:47
Добрый день! Интересует такой вопрос, при переносе папки с файлами из одного места в другое все связи в книгах excel нарушаются.
1) Можно ли как-то обновить связи во всей папке сразу?(файлов много) 2) Есть 12 папок, по 1 для каждого месяца, в папке с месяцем "январь" лежат файлы в которых я формулами создал много связей на другие книги. Данные файлы я взял за основу расчетов и по сути для месяца февраль мне нужно просто изменить одно слово в связях, к примеру
'С:\\\dadas\papka\Макет\январь\сюда скинуть сводные акты\[Сводный акт 1 .xls]АКТ'!$L$188 нужно заменить на 'С:\\\dadas\papka\Макет\февраль\сюда скинуть сводные акты\[Сводный акт 1 .xls]АКТ'!$L$188
Сейчас мне приходится заходить в папку каждого месяца и вручную через ctrl+H менять в ссылке в формулах слово январь на февраль, потом тоже самое придется делать для каждого месяца, можно ли как-то поменять сразу во всей папке?
