Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 3 4 5 6 7 8 След.
Получение значений из другого файла, (скорее всего макросом.)
 
R091n, Благодарю, но ваш макрос для меня китайская грамота, то есть я не смогу его адаптировать под рабочие таблицы. И к сожалению даже на тесте он не работает корректно, ставит везде прочерки  буквой Р (рубль)
Получение значений из другого файла, (скорее всего макросом.)
 
Путем Ctrl+C, Ctrl+V. Сделал макрос.
Вставляем значения с листа из файла report.xls, в файл Отчет.xlsm
Немного обрабатываем данные (удаляем лишнее + форматирование)
Использую формулу от R091n, за что огромное спасибо.
Опосля перевожу формулы в значения. Красота. Возможно нужно как-то довести макрос до ума, ну или и так сойдет.

Код
Sub Макрос1()
'
' Макрос1 Макрос


Application.ScreenUpdating = False
Application.DisplayAlerts = False

    Sheets("0_Report").Range("A1:F" & Cells(Rows.Count, "A").End(xlUp).Row).Clear
    Sheets("0_Report").Cells.Delete Shift:=xlUp
    Workbooks.Open Filename:="E:\333\333\report.xls"
    Workbooks("report.xls").Sheets("0_Report").Range("A1:C" & Cells(Rows.Count, "A").End(xlUp).Row).Copy ThisWorkbook.Sheets("0_Report").Range("A1")
    Workbooks("report.xls").Close False
    Sheets("0_Report").Select
    
    Range("A1:F9").UnMerge
    Range("A10:C" & Cells(Rows.Count, "A").End(xlUp).Row).Cut
    Range("A1").Select
    ActiveSheet.Paste
    Worksheets("0_Report").ListObjects.Add(xlSrcRange, Range("$A$1:$C$" & Cells(Rows.Count, "A").End(xlUp).Row), , xlYes).Name = _
        "Таблица2"
'    .ListObjects("Таблица2").TableStyle = "TableStyleLight1"
'    .ListObjects("Таблица2").Range.AutoFilter Field:=3, Criteria1:= _
'        "=ст. 93 ч. 1 п. 14", Operator:=xlOr, Criteria2:="="
'    .Range("D3:D" & Cells(Rows.Count, "A").End(xlUp).Row).ClearContents
'    .ListObjects("Таблица2").Range.AutoFilter Field:=3
    Range("Таблица2[#Headers]").Interior.ColorIndex = xlNone
    Columns("A:C").ColumnWidth = 20
    Cells.EntireRow.AutoFit
    Range("A1").Select


Sheets("Лист1").Select

Set Sheet = ActiveSheet
    For Each Row In Sheet.UsedRange.Rows
        If Row.Cells(3) Like "ДА" Then Row.Cells(4).Offset(0).FormulaR1C1 = "=SUMIFS('0_Report'!R3C3:R100C3,'0_Report'!R3C1:R100C1,[@дата],'0_Report'!R3C2:R100C2,[@Сумма])"
Next

Range("Таблица1[Исполнение]").Copy
Range("Таблица1[Исполнение]").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
  Application.CutCopyMode = False

'Возвращаем обновление экрана
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
Изменено: Николай - 26.10.2023 09:32:45
Получение значений из другого файла, (скорее всего макросом.)
 
R091n, Работает, но если report.xls закрыт, то нет. А если ли возможность работать с закрытым файлом?
Собственно поэтому и хотелось макрос, рабочая таблица достаточно большая, запустил макрос, он данные обновил и работай дальше.
Изменено: Николай - 25.10.2023 12:46:25
Получение значений из другого файла, (скорее всего макросом.)
 
Цитата
Sanja написал:
В файле report нет ячеек с пометкой (ДА).
Из файла report, основываясь на дате и сумме контракта, нужно найти ячейку с суммой исполнения.
Цитата
Sanja написал:
В файле report нет столбца Исполнение.
Это столбец называется "Сумма исполнения по контрактам с местными производителями на бумажном носителе"
Цитата
Sanja написал:
Что куда копировать и по какому условию?
Первой строкой советующей условию в файле Отчет, является строка 4
01.08.2023 29 458,80 ₽ ДА
В эту строку в столбец Исполнение, необходимо скопировать число из файла report из ячейки C15 (29458,8 )
Следующая строка по условию - 5
01.08.2023 8 000,00 ₽ ДА
Из report, С16 (6300)
Цитата
Sanja написал:
И причем тут даты в виде текста?
Считал что их сначала придется привести к правильному формату, чтобы появилась возможность сравнивать строки. Так как "дата" + "сумма" контракта всегда уникальны.
Изменено: Николай - 25.10.2023 08:15:35
Получение значений из другого файла, (скорее всего макросом.)
 
Всем доброго времени суток.
Есть два файла, Отчет и report.
В Отчет, в столбце Исполнение, с учетом ячейки с пометкой (ДА) необходимо скопировать значения из соответствующих ячейки в report.
В Отчете, в строках без пометки данные заносятся вручную.
В файле report, в графе дата сохранена как "недата".
Формулами не получается реализовать, так как все время выскакивают ошибки в умной таблице.
А вот чтобы макросом реализовать знаний не хватает, посему и прошу помощи.
Копировать ячейку с одного листа на другой с учетом условий в соседней ячейке
 
Приложил файл примера. Также обновил и шапку.

Ігор Гончаренко, спасибо, но не понятно, как это относится к указанному мной коду/файлу.

Цитата
БМВ написал: = Cells(i, 2)
Вах вах спасибо, понял,
Код
Worksheets("РАСЧЕТ").Cells(i, 2)

А я второй день мучаюсь не могу понять чего не работает.
Копировать ячейку с одного листа на другой с учетом условий в соседней ячейке
 
Всем доброго времени суток.
Подскажите как переделать запись правильно что бы считал на указанном листе.
Код
Sub Расклад_по_классам()
Dim LastRow As Long, Rw As Long
LastRow = Worksheets("РАСЧЕТ").Cells(Rows.Count, 1).End(xlUp).Row
    With Sheets("Лист1")
        Rw = .Cells(Rows.Count, 5).End(xlUp).Row + 1
        For i = 2 To LastRow
             If Worksheets("РАСЧЕТ").Cells(i, 1) = "1А" Or _
             Worksheets("РАСЧЕТ").Cells(i, 1) = "1Б" Or _
             Worksheets("РАСЧЕТ").Cells(i, 1) = "2А" Or _
             Worksheets("РАСЧЕТ").Cells(i, 1) = "2Б" Or _
             Worksheets("РАСЧЕТ").Cells(i, 1) = "3А" Or _
             Worksheets("РАСЧЕТ").Cells(i, 1) = "3Б" Or _
             Worksheets("РАСЧЕТ").Cells(i, 1) = "4А" Or _
             Worksheets("РАСЧЕТ").Cells(i, 1) = "4Б" Then
                .Cells(Rw, 5).Value = Cells(i, 2)
                Rw = Rw + 1
            End If
        Next
          Rw = .Cells(Rows.Count, 8).End(xlUp).Row + 1
        For i = 2 To LastRow
             If Worksheets("РАСЧЕТ").Cells(i, 1) = "5А" Or _
             Worksheets("РАСЧЕТ").Cells(i, 1) = "5Б" Or _
             Worksheets("РАСЧЕТ").Cells(i, 1) = "6А" Or _
             Worksheets("РАСЧЕТ").Cells(i, 1) = "6Б" Or _
             Worksheets("РАСЧЕТ").Cells(i, 1) = "7А" Or _
             Worksheets("РАСЧЕТ").Cells(i, 1) = "7Б" Or _
             Worksheets("РАСЧЕТ").Cells(i, 1) = "8А" Or _
             Worksheets("РАСЧЕТ").Cells(i, 1) = "8Б" Or _
             Worksheets("РАСЧЕТ").Cells(i, 1) = "9А" Or _
             Worksheets("РАСЧЕТ").Cells(i, 1) = "9Б" Then
                .Cells(Rw, 8).Value = Cells(i, 2)
                Rw = Rw + 1
            End If
        Next
         Rw = .Cells(Rows.Count, 11).End(xlUp).Row + 1
        For i = 2 To LastRow
             If Worksheets("РАСЧЕТ").Cells(i, 1) = "10А" Or _
             Worksheets("РАСЧЕТ").Cells(i, 1) = "10Б" Or _
             Worksheets("РАСЧЕТ").Cells(i, 1) = "11А" Or _
             Worksheets("РАСЧЕТ").Cells(i, 1) = "11Б" Then
                .Cells(Rw, 11).Value = Cells(i, 2)
                Rw = Rw + 1
            End If
        Next
    End With
End Sub 


Сейчас if ищет на выделенном листе, а вот как указать выполнение на листе РАСЧЕТ?
Изменено: Николай - 13.03.2021 13:15:29
Количество учеников в классах с 1а по 4в
 
Не удачный пример выложил. Исправил.
Если выбрать 11 класс то считает и их.
А мне еще потом нужно будет подсчитывать только видимые позиции (применение фильтра)
Количество учеников в классах с 1а по 4в
 
Всем доброго времени суток.
Есть таблица (см пример)
Вопрос как посчитать только учеников с 1А по 4Б, что то не могу найти подходящую формулу что так сказать одним махом а не суммировать подсчет каждой буквы по отдельности.
Макрос сохранения последнего видимого листа в отдельный файл "CSV (разделители - запятые)"
 
Valo,
Цитата
Valo написал:
Получилось?
А то...
Благодарю.
Как это я на кавычки не обратил внимание, ведь когда пробовал, внутри скобок, то писал с кавычками...
Макрос сохранения последнего видимого листа в отдельный файл "CSV (разделители - запятые)"
 
Hugo, Не работает. То есть сохраняет НО только исходное имя.
Макрос сохранения последнего видимого листа в отдельный файл "CSV (разделители - запятые)"
 
Дописал после сохранения новой книги следующий код.
Код
ActiveWorkbook.Close False 'Закроет активную книгу без сохранения   

Никак не могу добавить к имени файла нужный текст.
Код
Name = ActiveWorkbook.Path & "\" & Replace(Otchet_ & ActiveWorkbook.Name, ".xlsx", ".csv")

Что не так?
Макрос сохранения последнего видимого листа в отдельный файл "CSV (разделители - запятые)"
 
Цитата
Valo написал:
Попробуйте так, должно сработать.
Гениально. Все работает. Отлично. Благодарю от всей души.
Макрос сохранения последнего видимого листа в отдельный файл "CSV (разделители - запятые)"
 
Погодь. У меня макрос хранится в персональной книге макросов. И запускается из панели быстрого доступа.

Из файла работает нормально.
НО нужно чтобы запускался из книги макросов. Так как нужно будет обрабатывать присылаемые файлы.
Приношу извинения, что не указал данный нюанс.
Макрос сохранения последнего видимого листа в отдельный файл "CSV (разделители - запятые)"
 
Все равно ошибка (как во втором случае)
Макрос сохранения последнего видимого листа в отдельный файл "CSV (разделители - запятые)"
 
Вот пример файла.
Макрос сохранения последнего видимого листа в отдельный файл "CSV (разделители - запятые)"
 
Не работает ни так
Код
ActiveWorkbook.SaveAs Filename:=Name, FileFormat:=xlCSVUTF8

Ни так
Код
ActiveWorkbook.SaveAs Filename:=Name, FileFormat:=xlCSV

В первом случае

Во втором
Изменено: Николай - 15.04.2019 21:53:49
Макрос сохранения последнего видимого листа в отдельный файл "CSV (разделители - запятые)"
 
Всем доброго времени суток.
Нужен макрос, для сохранения последнего видимого листа в файл тип файла "CSV (разделители - запятые)".
Сохраняем в туже директорию с таким же именем как у исходного файла.
Как ни пробовал переделать шаблон ни чего путного не получается.
Изменено: Николай - 15.04.2019 18:47:23
Выпадающие списки с зависимостью от данных в других столбцах
 
lebedevco,
Дык выложи ссылку на видео мало ли кому пригодится.
Как трансформировать телефонную книгу в виде плоской таблицы с повторяющимися полями, в двумерную таблицу
 
JayBhagavan, Благодарю от всей души. Работает так как надо.
Жаль что я в нем нихрена не понимаю.
БМВ, Как я не пытался ничего путного у меня так и не вышло, возможно знаний маловато, для такой задачи. Если бы у каждого абонента были бы все параметры, то тогда да и самостоятельно справился бы.
Еще раз благодарю JayBhagavan за предоставленное решение.
Как трансформировать телефонную книгу в виде плоской таблицы с повторяющимися полями, в двумерную таблицу
 
Всем доброго времени суток.
После длительных манипуляций по восстановление телефонной книги получил файл вида, см вложение.
Где в два столбца по порядку записаны Имя, телефон1, телефон2 (если есть), группа, как мне представить это в таблицу с заголовками. Имя, телефон1, телефон2 (если есть), группа,
Изменено: Николай - 26.10.2018 06:01:57
Формирование ссылки макросом на предыдущий лист
 
Решил вопрос, самостоятельно.
Код
Range("B3").Formula = "=" & ActiveSheet.Previous.Name & "!C3"
Изменено: Николай - 28.02.2018 17:57:19
Формирование ссылки макросом на предыдущий лист
 
Всем доброго времени суток.
Есть файл с листами январь, февраль и т.д.
Для примера необходимо на листе февраль в ячейке В3 сформировать ссылку на лист январь на ячейку С3
Как сие сделать с помощью макроса.
Чтобы в последствии запуская макрос на следующих листах так же создавалась ссылка на предыдущий лист а не на январь.
Пример приложил.
Умные таблицы. Сссылка из одной книги в другую.
 
Не вариант так как строка итогов будет сдвигаться в низ.
Создал дополнительный лист в рабочей книге и таким образом решил задачу.
Умные таблицы. Сссылка из одной книги в другую.
 
Всем доброго времени суток.
Столкнулся с такой задачей.
В ячейке первой книги показать значение из итогового поля умной таблицы второй книги. И оказалось что значения отображаются пока открыта вторая книга. Если обе книги закрыть, а потом открыть первую книгу, то на месте значений будет вот такой текст #ССЫЛКА!
НО если во второй книге рядом с умной таблицей создать ячейки которые будут вросто равны значениям из умной таблицы, и в первой книге сослаться на них, то тогда данные будут нормально обновляться и храниться.
Получается нужно создавать дублирующие ячейки? По другому никак.
Для примера приложил два файла.
Макрос. Выбор файлов в каталоге.
 
Nordheim,
Понятия не имею, я предполагал что это ограничитель максимального количества циклов, так как файлов у меня всего 18 то и не особо и заморачивался.
З.Ы. Так как желание научится VBA есть, а учителей нет, то стараюсь тянуть готовый код из примеров, или аналогичных задач (что находятся поиском) подстраивать под свои нужны, и если уже совсем никак, то иду на форумы за помощью.
В начале VBA код вообще казался мне китайской грамотой, но постепенно понимаю что к чему, но знаний все равно мало.
Макрос. Выбор файлов в каталоге.
 
Победил методом проб и ошибок.
Вот такой код заработал на ура.
Код
Sub Подготовка_к_отчету()
    Dim oFD As FileDialog
    Dim x, lf As Long
    'назначаем переменной ссылку на экземпляр диалога
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .InitialFileName = ThisWorkbook.Path & "\" 'путь "по умолчанию" расположение файла.
        If .Show = 0 Then Exit Sub 'показывает диалог
        'цикл по коллекции выбранных в диалоге файлов
        For lf = 1 To .SelectedItems.Count
            x = .SelectedItems(lf) 'считываем полный путь к файлу
        'отключаем обновление экрана, чтобы наши действия не мелькали
        Application.ScreenUpdating = False
        With UserForm1
        .Show 0
        .Label1.Caption = "Работаем..."
        .Repaint
        For i = 1 To 100000000
        Next
        .Label1.Caption = "ГОТОВО"
        End With
        Workbooks.Open x 'открытие книги
        'можно также без х
        'Workbooks.Open .SelectedItems(lf)
        'действия с файлом
        
    'Выравнивание строк
    Sheets("Микроучасток").Rows("1:4").RowHeight = 20
    'конец выравнивания строк

    
    'Закрываем книгу с сохранением изменений
        ActiveWorkbook.Close True 'если поставить False - книга будет закрыта без сохранения
        Next
    
    'возвращаем ранее отключенное обновление экрана
    Application.ScreenUpdating = True
     
     End With
End Sub
Макрос. Выбор файлов в каталоге.
 
Вот такой код отрабатывает корректно.
Код
Sub Подготовка_к_отчету()
    Dim oFD As FileDialog
    Dim x, lf As Long
    'назначаем переменной ссылку на экземпляр диалога
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .InitialFileName = ThisWorkbook.Path & "\" 'путь "по умолчанию" расположение файла.
        If .Show = 0 Then Exit Sub 'показывает диалог
        'цикл по коллекции выбранных в диалоге файлов
        For lf = 1 To .SelectedItems.Count
            x = .SelectedItems(lf) 'считываем полный путь к файлу
        'отключаем обновление экрана, чтобы наши действия не мелькали
        Application.ScreenUpdating = False
        Workbooks.Open x 'открытие книги
        'можно также без х
        'Workbooks.Open .SelectedItems(lf)
        'действия с файлом
        
    'Выравнивание строк
    Sheets("Микроучасток").Rows("1:4").RowHeight = 20
    'конец выравнивания строк
    
        'Закрываем книгу с сохранением изменений
        ActiveWorkbook.Close True 'если поставить False - книга будет закрыта без сохранения
        Next
    
    'возвращаем ранее отключенное обновление экрана
    Application.ScreenUpdating = True
    
    End With
End Sub


Проблема возникает при добавлении  

Кода картинки о выполнении.
Код
With UserForm1
        .Show 0
        .Label1.Caption = "Работаем..."
        .Repaint
        For i = 1 To 100000000
        Next
...
...
...

.Label1.Caption = "ГОТОВО"

Как-то не правильно значит добавляю, кто сможет подсказать как правильно сделать?
Макрос. Выбор файлов в каталоге.
 
Hugo,
Этот loop вот из этого показа картинки с надписью работаем :-)
Код
With UserForm1
        .Show 0
        .Label1.Caption = "Работаем..."
        .Repaint
        For i = 1 To 100000000
        Next

З.Ы. Надо будет и в коде смайлик прописать :-)
Макрос. Выбор файлов в каталоге.
 
Вот как выглядит оригинальный рабочий файл.
Если кому конечно будет интересно.
Страницы: 1 2 3 4 5 6 7 8 След.
Наверх