Excel это не сложно

Основные форумы => Полезные решения => Тема начата: Andrew-P от 13.09.2017, 11:35:03



Название: Копирование и вставка данных при помощи макроса
Отправлено: Andrew-P от 13.09.2017, 11:35:03
Доброго времени суток, уважаемые форумчане. Вот, как и всё хорошее незаметно закончилось лето.
Предлагаю Вашему вниманию файл, который упрощает и ускоряет процесс копирования и вставки данных из файла-источника в файл-приемник.
Для чего это нужно и где может пригодиться...
Многие онлайн-сервисы и программы могут формировать отчеты с данными в csv формате. Часто возникает необходимость эти данные копировать и вставлять в файл итогового отчета. При этом при копировании и вставки данных необходимо соблюдать соответствие колонок файла-источника и файла-приемника, причем в файле-приемнике данные должны быть в редактируемом числовом формате. Кроме того, если регулярно заниматься редактированием и вставкой таких данных, то в результате человеческого фактора и невнимательности иногда происходит "задвоение" данных, что нарушает логику расчетов в итоговом отчете.
Так вот, для исключения такого рода ошибок, ускорения процесса регулярного копирования и вставки данных и предназначен мой простенький файлик :)

P.S. Для корректной работы файла"копирования и вставки данных" необходимо, что-бы в файле-приемнике данные были отсортированы по возрастанию.


Название: Re:Копирование и вставка данных при помощи макроса
Отправлено: Andrew-P от 13.09.2017, 23:54:23
Давно хотел разобраться, как работают "публичные" переменные.
Вот пример небольшого макроса, который позволяет сохранить данные о файле-источнике, или файле-приемнике пока активна рабочая книга.
Это позволит использовать данные для дальнейшей работы нескольких макросов.

Код: (vb)

Option Explicit
Public avFiles1 As String
Public vbName1 As String
Public Shname1 As String


Sub Откуда_копируем()
Dim WB1 As Object
Dim WBSh1 As Object
avFiles1 = Application.GetOpenFilename _
                ("All Files(*.*),*.*", True)
 If VarType(avFiles1) = vbBoolean Then
    Exit Sub
    End If
With Application: .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlManual: .DisplayAlerts = False: End With
    Workbooks.Open Filename:=avFiles1
vbName1 = Right(avFiles1, Len(avFiles1) - InStrRev(avFiles1, "\"))
Set WB1 = Workbooks(vbName1)
Set WBSh1 = WB1.Sheets(1)
Shname1 = WBSh1.Name
Workbooks(vbName1).Close False
With Application: .ScreenUpdating = True: .EnableEvents = True: .Calculation = xlAutomatic: .DisplayAlerts = True: End With
End Sub



Название: Re:Копирование и вставка данных при помощи макроса
Отправлено: Andrew-P от 15.09.2017, 23:23:15
Или такой вариант:
Код: (vb)

Option Explicit
Public avFiles As String
Public vbName As String
Public Shname As String
Sub Куда_вставляем()
Dim objCloseBook As Object
Dim ObjCloseBookSh As Object
avFiles = Application.GetOpenFilename _
                ("All Files(*.*),*.*", True)
    If VarType(avFiles) = vbBoolean Then
    Exit Sub
    End If
 Set objCloseBook = GetObject(avFiles)
 Set ObjCloseBookSh = objCloseBook.Sheets(4)
 vbName = Right(avFiles, Len(avFiles) - InStrRev(avFiles, "\"))
 Shname = ObjCloseBookSh.Name
 Workbooks(vbName).Close False
End Sub


Название: Re:Копирование и вставка данных при помощи макроса
Отправлено: sckameikin22 от 25.11.2017, 17:52:57
А что, неплохой алгоритм.