копирование столбца из excel в другой excel
Добрый день имеются множество файлов ( пример прикрепил ). Можно ли как то из этих всех файлов вырезать только один столбец (NUM ) И чтоб нумерация из этих столбцов была полностью видна. То есть при нажатии скриптов создавались бы excel файлы только с Num столбцами. Эти файлы лежат на D:\Новая папка а экспорт новых excel файлов например на D:\Новая папка2
|
Цитата:
Цитата romfus
имеются множество файлов ( пример прикрепил ). »
|
Если речь ведётся о «множестве», лучше сразу давать два-три файла, а не один, дабы было с чем работать.
Цитата:
Цитата romfus
Можно ли как то из этих всех файлов вырезать только один столбец (NUM ) И чтоб нумерация из этих столбцов была полностью видна. То есть при нажатии скриптов создавались бы excel файлы только с Num столбцами. Эти файлы лежат на D:\Новая папка а экспорт новых excel файлов например на D:\Новая папка2 »
|
Можно. Только не на пакетных файлах, а посредством чего0либо, поддерживающего Automation — WSH, PowerShell, AutoIt и т.п.
А какова цель сего действа? Вот мы удалили из листа Рабочей книги все столбцы, кроме num, выровняли его, сохранили под тем же именем в конечный каталог. Затем другую Рабочую книгу, третью… А что дальше? |
Вложений: 1
Да просто этих файлов у меня штук 100. и так каждый открывать удалять на это времени много уходит. Просто мне нужно этот Num столбец потом будет еще распечатать. Проще ж потом выделить сформированные файлы и все разом пустить на печать а не открывать каждый потом удалять потом на печать. Вот вам 2 файл для примера.
|
Да и мне нужно чтобы оригинал файла сохранился. Хотя знаете можно просто тогда удалить из оригинала и все. Я если что найду способ как оригиналы найти
|
romfus, ну, пробуйте (на WSH):
Скрытый текст
Код:
Option Explicit
Dim strSourceFolder
Dim strDestFolder
Dim objFSO
Dim objFile
Dim objExcel
strSourceFolder = "C:\Мои проекты\0155\Source"
strDestFolder = "C:\Мои проекты\0155\Destination"
Set objExcel = Nothing
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists(strSourceFolder) Then
If objFSO.FolderExists(strDestFolder) Then
For Each objFile In objFSO.GetFolder(strSourceFolder).Files
Select Case LCase(objFSO.GetExtensionName(objFile.Name))
Case "xls", "xlsx"
If objExcel Is Nothing Then
Set objExcel = WScript.CreateObject("Excel.Application")
End If
With objExcel
With .Workbooks.Open(objFile.Path)
With .Worksheets.Item(1)
If StrComp(.Cells(1, 1).Value, "num", vbTextCompare) = 0 Then
With .UsedRange.EntireColumn
.Offset(0, 1).Delete
.AutoFit
End With
Else
WScript.Echo "Can't find [num] in A1 cell in first worksheet in [" & objFile.Name & "] workbook."
End If
End With
.SaveAs objFSO.BuildPath(strDestFolder, objFile.Name)
.Close
End With
End With
Case Else
' Nothing to do
End Select
Next
objExcel.Quit
Set objExcel = Nothing
Else
WScript.Echo "Can't find destination folder [" & strDestFolder & "]."
WScript.Quit 2
End If
Else
WScript.Echo "Can't find source folder [" & strSourceFolder & "]."
WScript.Quit 1
End If
Set objFSO = Nothing
WScript.Quit 0
Но у меня возник вопрос — вот, Вы распечатываете результирующие Рабочие книги. И только? А потом они Вам не требуются, и Вы их удаляете? Если так, то вовсе нет никакой нужды в сохранении Рабочих книг: можно удалить все столбцы, кроме num, подогнать ширину столбца num по содержимому, отправить результат на печать и закрыть Рабочую книгу, никуда не сохраняя :). Как Вам такое? Или же Вы там ещё каким-то хитрым образом подгоняете, масштабируете, соединяете результирующие данные?
|
Что-то не запускается скрипт. Как его запустить? Дак нам приходит ежедневно по 100 таких файлов. Это ж нужно каждый так открывать удалять печатать и т д
А все . Работает. А вот такой вопрос. А нельзя ли чтобы столбец NUM шел не просто вниз а по всему листу?. ПРи печати хорошая Экономия бумаги получится. То что я вам кинул это самый маленький файл. Так если на печатаь бросать результат получается на 8 листов аж
|
Цитата:
Цитата romfus
Что-то не запускается скрипт. Как его запустить? »
|
Сохранить код в файл с расширением .vbs, указав свои пути к исходному и целевому каталогам. Запустить двойным щелчком.
Цитата:
Цитата romfus
Дак нам приходит ежедневно по 100 таких файлов. Это ж нужно каждый так открывать удалять печатать и т д »
|
Так я и предлагаю: если Вы только печатаете результирующие Рабочие книги, и ничего больше — сделать так, чтобы Вам не приходилось каждую исправленную Рабочую книгу открывать, печатать и закрывать. Пробуем, делаем? |
romfus, а что с текущим скриптом — заработал он у Вас, або нет?
|
Заработал да. Я отписался что работает
|
Пробуйте:
Скрытый текст
Код:
Option Explicit
Dim strSourceFolder
Dim objFSO
Dim objFile
Dim objExcel
If WScript.Arguments.Count = 1 Then
strSourceFolder = WScript.Arguments.Item(0)
Set objExcel = Nothing
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists(strSourceFolder) Then
For Each objFile In objFSO.GetFolder(strSourceFolder).Files
Select Case LCase(objFSO.GetExtensionName(objFile.Name))
Case "xls", "xlsx"
If objExcel Is Nothing Then
Set objExcel = WScript.CreateObject("Excel.Application")
End If
With objExcel
With .Workbooks.Open(objFile.Path)
With .Worksheets.Item(1)
If StrComp(.Cells(1, 1).Value, "num", vbTextCompare) = 0 Then
With .UsedRange.EntireColumn
.Offset(0, 1).Delete
.AutoFit
End With
.PrintOut
Else
WScript.Echo "Can't find [num] in A1 cell in first worksheet in [" & objFile.Name & "] workbook."
End If
End With
.Close False
End With
End With
Case Else
' Nothing to do
End Select
Next
objExcel.Quit
Set objExcel = Nothing
Else
WScript.Echo "Can't find source folder [" & strSourceFolder & "]."
WScript.Quit 2
End If
Else
WScript.Echo "Usage: cscript.exe //nologo """ & WScript.ScriptName & """ <Source folder>"
WScript.Quit 1
End If
Set objFSO = Nothing
WScript.Quit 0
Путь к исходной папке указывается параметром скрипта (также можно просто перетащить исходную папку на скрипт в Проводнике). |
Usage cscript.exe //nologo "3.vbs" <Source folder> как тут быть?
а все разобрался
|
Цитата:
Цитата romfus
Заработал да. Я отписался что работает »
|
Ясно. Я не увидел то, что Вы дописывали.
Цитата:
Цитата romfus
А вот такой вопрос. А нельзя ли чтобы столбец NUM шел не просто вниз а по всему листу?. ПРи печати хорошая Экономия бумаги получится. То что я вам кинул это самый маленький файл. Так если на печатаь бросать результат получается на 8 листов аж »
|
Можно будет попробовать. Сверху вниз, затем слева направо, затем опять сверху вниз, затем опять слева направо, …, затем следующий лист и повторяем то же самое, так? |
Цитата:
Цитата romfus
Usage cscript.exe //nologo "3.vbs" <Source folder> как тут быть?
а все разобрался »
|
Удобнее всего Вам будет просто перетаскивать папку на скрипт в Проводнике — подхватить папку, перетащить и бросить её на скрипт. |
Да да. Я тут разобрался уже
|
Тогда давайте, чтоб не заниматься излишней универсализацией (да я и не уверен, что такое возможно в принципе, всё ж это не Microsoft Access), Вы посчитаете, сколько столбцов у Вас, на Вашем принтере, умещаются на одной странице при печати (и, кстати, мы будем вставлять для наглядности по короткому пустому вспомогательному столбцу между основными?) и сколько строк у Вас умещается на одной странице при печати. От этого и будем танцевать. |
7 строк по горизонтали и 56 по вертикали
|
romfus, Вы точно уверены насчёт семи столбцов? У меня токмо шесть помещаются. И — по короткому пустому столбцу между столбцами будем вставлять для наглядности, або нет?
|
не нужно пустого столбца. Да. 7
|
romfus, я сейчас отлучён от компьютера, не могу выдать решение, но лучше написать, например, vbs- скрипт, который последовательно откроет эксел-файлы, выделит в них нужную область и напечатает выделенное. Помнится, такая возможность в экселе была.
Либо создать пустой бланк для печати столбца, настроить параметры листа для аывода, макросом в этом бланке последовательно открывать ваши файлы, забирать нужную область и сразу пускать на печать, затем очищать напечатанное и т д.....
Корёжить исходные файлы или делать кучу новых только для печати- плохая идея. Ведь цель всей возни - напечатать выделенные области из всех указанных файлов.
|
megaloman, ну, вроде бы уже решили, что корёжить не будем, сохранять не будем, будем токмо печатать. Осталось сообразить, как сие реализовать наиболее доступным образом ;).
|
Iska, пока я тыркал пальцем в планшет, у Вас состоялось бурное объяснение :) Имхо, проще и надёжнее сделать бланк и далее по тексту предыдущего поста
|
romfus, ну, пробуйте, что получилось:
Скрытый текст
Код:
Option Explicit
Const intColumns = 7
Const intRows = 56
Dim strSourceFolder
Dim objFSO
Dim objFile
Dim objExcel
Dim objSourceSheet
Dim objDestSheet
Dim objSourceRange
Dim objDestRange
If WScript.Arguments.Count = 1 Then
strSourceFolder = WScript.Arguments.Item(0)
Set objExcel = Nothing
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists(strSourceFolder) Then
For Each objFile In objFSO.GetFolder(strSourceFolder).Files
Select Case LCase(objFSO.GetExtensionName(objFile.Name))
Case "xls", "xlsx"
If objExcel Is Nothing Then
Set objExcel = WScript.CreateObject("Excel.Application")
End If
With objExcel
With .Workbooks.Open(objFile.Path)
Set objSourceSheet = .Worksheets.Item(1)
Set objDestSheet = .Worksheets.Add
If StrComp(objSourceSheet.Cells(1, 1).Value, "num", vbTextCompare) = 0 Then
Set objSourceRange = objSourceSheet.Range(objSourceSheet.Cells(1, 1), objSourceSheet.Cells(intRows, 1))
Set objDestRange = objDestSheet.Cells(1, 1)
objSourceRange.Copy objDestRange
Do Until objExcel.Intersect(objSourceSheet.UsedRange, objSourceRange) Is Nothing
Set objSourceRange = objSourceRange.Offset(intRows, 0)
If objDestRange.Column = intColumns Then
objDestSheet.VPageBreaks.Add objDestRange.Offset(0, 1)
Set objDestRange = objDestRange.Offset(intRows, 1 - intColumns)
objDestSheet.HPageBreaks.Add objDestRange
Else
Set objDestRange = objDestRange.Offset(0, 1)
End If
objSourceRange.Copy objDestRange
Loop
objDestSheet.UsedRange.Columns.AutoFit
objDestSheet.PrintOut
Else
WScript.Echo "Can't find [num] in A1 cell in first worksheet in [" & objFile.Name & "] workbook."
End If
.Close False
End With
End With
Case Else
' Nothing to do
End Select
Next
objExcel.Quit
Set objExcel = Nothing
Else
WScript.Echo "Can't find source folder [" & strSourceFolder & "]."
WScript.Quit 2
End If
Else
WScript.Echo "Usage: cscript.exe //nologo """ & WScript.ScriptName & """ <Source folder>"
WScript.Quit 1
End If
Set objFSO = Nothing
WScript.Quit 0
После седьмого столбца и после каждой пятьдесят шестой строки вставляются жёсткие разрывы страницы.
|
Время: 18:33.
© OSzone.net 2001-
