Изменения значения столбца в xls
Добрый день. Имеется файл в xls формате в папке D:\IVC\Operators\Printer\22.05.2018 ( Дата ежедневно меняется) с количеством строк от 3 - 20 тысяч. В зависимости от того сколько нам дадут данных значений. Возможно ли чтобы скрипт считывал весь столбец ( Наименование столбца indexto ячейка B1 ) и изменял необходимые данные на другие значения? Например если попадется 368200 меняется на 368211. 142191 на 108840 366100 на 366108 366600 на 366611 367033 на 367901 364901 на 364910. Остальных значений которые нужно менять я пока не знаю. Но буду сам дополнять в этот скрипт, если он получится . Для примера кидаю файл с 7360 строками https://yadi.sk/i/oRqx-IX83WPjYt |
В Данном файле что я прикрепил нет таких индексов. Но для проверки например 403995 изменить на 403996 Я поэтому примеру сделаю на другие нужные мне индекса
|
romfus, можно считывать, можно менять. Главный вопрос — по какому принципу?
|
ну как понять по какому принципу? запускаю скрипт, этот скрипт в папке находит этот xls ( он один там ) считывает в этом xls стоблец b1. Если находит в нем 403995 изменяет на 403996 затем как все считал закрыл этот xls и сохранил.
|
romfus, откуда скрипт узнает, что нужно искать 403995, и откуда скрипт узнает, что менять нужно на 403996? Откуда скрипт узнает, что нужно искать 368200, и откуда скрипт узнает, что менять нужно на 368211? И т.д.
|
а в cmd нет выборки? м.б в VBS есть?
Вот например в данном скрипте в xls изменяется ячейка f1 ( меняется на слово street )
Код:
ExtIn = "xls" 'Расширение Excel-файла
RangeIn = "F1" 'Адрес клетки
TxtIn = "street"
BoxIn = "D:\IVC\Operators\Printer" ' Папка с Excel-файлами
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WShell = CreateObject("WScript.Shell")
On Error Resume Next
Set InBox = FSO.GetFolder(BoxIn)
If Err.Number <> 0 Then
LL = WShell.Popup("Папка" + vbCrLf + vbCrLf + BoxIn + vbCrLf + vbCrLf + "Код ошибки " + CStr(Err.Number) + vbCrLf + Err.Description, 0, "Открытие папки", 16)
On Error GoTo 0
Else
Set XL = CreateObject("Excel.Application")
' XL.Visible = True
XL.Visible = False
On Error GoTo 0
Set AllFiles = InBox.Files
For Each File In AllFiles
XlsName = BoxIn + "\" + File.Name
If LCase(FSO.GetExtensionName(XlsName)) = LCase(ExtIn) Then
Set XLbook = XL.Workbooks.Open(XlsName)
XL.Range(RangeIn) = TxtIn
TxtName = BoxTxt + "\" + CStr(XL.Range(RangeIn).Value)
XLbook.Save
XLbook.Close
End If
Next
XL.Quit
End If
вопрос просто только как он найдет определенный индекс. В данном скрипте выше там уже значение ячейки выдает которое нужно менять
а может скрипт искать именно цифру в xls а не определенную ячейку? То есть если встретится 403995 то я ее меняю |
Скрипт просматривает ячейки в указанном столбце и меняет значения в соответствии с указанными правилами
Код:
FileIn = "Z:\Box_In\34S_400139 - 404622_21222.xls" 'Имя файла
With WScript.Arguments
If .Count <> 0 Then FileIn = .Item(0)
End With
' Массив с парами заменяемых значений ("что","на что")
NRepl = Array("403001", "123001", _
"403013", "123013", _
"404622", "123622")
RangeIn = "B1" 'Адрес клетки c заголовком столбца
N1 = LBound(NRepl)
N2 = UBound(NRepl)
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WShell = CreateObject("WScript.Shell")
On Error Resume Next
Set InBox = FSO.GetFile(FileIn)
If Err.Number <> 0 Then
LL = WShell.Popup("Файл" + vbCrLf + vbCrLf + FileIn + vbCrLf + vbCrLf + "Код ошибки " + CStr(Err.Number) + vbCrLf + Err.Description, 0, "Открытие папки", 16)
On Error GoTo 0
Else
With CreateObject("Excel.Application")
.Visible = True
' .Visible = False
On Error GoTo 0
Set XLbook = .Workbooks.Open(FileIn)
i = 0
Do
i = i + 1
iCell = Trim(CStr(.Range(RangeIn).Offset(i, 0)))
If Len(iCell) = 0 Then Exit Do
For j = N1 To N2 Step 2
If iCell = NRepl(j) Then
.Range(RangeIn).Offset(i, 0) = NRepl(j + 1)
Exit For
End If
Next
Loop
XLbook.Save
XLbook.Close
.Quit
End With
End If
MsgBox "Скрипт завершен"
Имя файла можно указать прямо в скрипте, либо сделать на скрипт значок на раб. столе и затягивать мышкой на него обрабатываемый файл, при этом имя явно указанного в скрипте файла будет проигнорировано.
|
А форматирование оригинального файла этот скрипт может сохранить? а то он заменяет текст а форматирование меняется
|
Мой вариант — на базе OLE DB:
Код:
Option Explicit
Dim objDictionary
Dim objFSO
Dim strSourceFile
Dim objConnection
Dim objCatalog
Dim objTable
Dim strPostCode4Find
Dim intRecordsAffected
Set objDictionary = WScript.CreateObject("Scripting.Dictionary")
With objDictionary
.Add "368200", "368211"
.Add "142191", "108840"
.Add "366100", "366108"
.Add "366600", "366611"
.Add "367033", "367901"
.Add "364901", "364910"
.Add "403995", "403996"
.Add "404116", "999999"
.Add "404113", "888888"
End With
If WScript.Arguments.Count = 1 Then
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
strSourceFile = objFSO.GetAbsolutePathName(WScript.Arguments.Item(0))
If objFSO.FileExists(strSourceFile) Then
Set objConnection = WScript.CreateObject("ADODB.Connection")
Set objCatalog = WScript.CreateObject("ADOX.Catalog")
WScript.Echo "Почтовый индекс [" & strPostCode4Find & "] встречается в:"
WScript.Echo "------------------------------------------------------------------"
If StrComp(objFSO.GetExtensionName(strSourceFile), "xls", vbTextCompare) = 0 Then
WScript.Echo "[" & strSourceFile & "]"
With objConnection
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Properties.Item("Extended Properties").Value = "Excel 8.0;HDR=Yes;IMEX=0"
.Open strSourceFile
objCatalog.ActiveConnection = objConnection
For Each objTable In objCatalog.Tables
If StrComp(objTable.Type, "TABLE", vbTextCompare) = 0 Then
WScript.Echo vbTab & "[" & objTable.Name & "]"
For Each strPostCode4Find In objDictionary.Keys
objConnection.Execute "UPDATE [" & objTable.Name & "] SET indexto = '" & objDictionary.Item(strPostCode4Find) & "' WHERE indexto = '" & strPostCode4Find & "'", intRecordsAffected
WScript.Echo vbTab & vbTab & "[" & strPostCode4Find & "] ---> [" & objDictionary.Item(strPostCode4Find) & "]: " & vbTab & intRecordsAffected & " раз(а)"
Next
End If
Next
objCatalog.ActiveConnection = Nothing
.Close
End With
Else
WScript.Echo "Probably source file [" & strSourceFile & "] not an Excel (.xls) file."
WScript.Quit 3
End If
WScript.Echo "------------------------------------------------------------------"
Set objCatalog = Nothing
Set objConnection = Nothing
Else
WScript.Echo "Source file [" & strSourceFile & "] not found."
WScript.Quit 2
End If
Set objFSO = Nothing
Else
WScript.Echo "Usage: cscript.exe //nologo """ & WScript.ScriptFullName & """ <Source file>"
WScript.Quit 1
End If
objDictionary.RemoveAll
Set objDictionary = Nothing
WScript.Quit 0
Исходный файл указывается аргументом скрипта (также можно просто перетянуть файл из Проводника на скрипт). Всё, что я писал Вам ранее в этой теме: CMD/BAT - [решено] CMD/BAT - Скрипт, который считывает количество данных из разных таблиц Excel касательно окружения исполнения — будет справедливо и здесь. |
romfus, Меняется не всё форматирование, а только выравнивание по горизонтали. Если надо выравнивать по левому краю, то добавьте строку:
Код:
..................
If iCell = NRepl(j) Then
.Range(RangeIn).Offset(i, 0) = NRepl(j + 1)
.Range(RangeIn).Offset(i, 0).HorizontalAlignment = xlLeft
Exit For
End If
...............
|
megaloman, полагаю, если вставлять как текст:
Код:
.Range(RangeIn).Offset(i, 0).Value = "'" & CStr(NRepl(j + 1))
— выравниваться вправо не будет (не проверялось).
|
Iska, Я сам пробовал так делать. Действительно, выравнивание сохраняется, но при просмотре ячейки по F2 апостроф перед числом виден. Я посчитал это некорректным.
То, что сделал я, тоже костыль нехороший: ранее содержимое было текст, а стало числом.
Правильнее, вместо предыдущего костыля такое вот решение (каюсь, надо было не лениться и мозги раньше включить):
Код:
.Range(RangeIn).Offset(i, 0).NumberFormat = "@"
.Range(RangeIn).Offset(i, 0) = NRepl(j + 1)
ИМХО (но это надо глубже знать задачу), лучше отформатировать весь столбец сразу как текстовый - быстрее будет выполняться.
Код:
.Columns(.Range(RangeIn).Column).NumberFormat = "@"
i = 0
Do
i = i + 1
iCell = Trim(CStr(.Range(RangeIn).Offset(i, 0)))
If Len(iCell) = 0 Then Exit Do
For j = N1 To N2 Step 2
If iCell = NRepl(j) Then
.Range(RangeIn).Offset(i, 0) = NRepl(j + 1)
Exit For
End If
Next
Loop
CStr(NRepl(j + 1)) здесь не нужно, элементы этого массива изначально записывались как литералы.
Я не проверял решение в случае, если замены надо делать не со строками, которые можно интерпретировать как число, а как голимые литералы. Подозреваю, и в этом случае скрипт будет работать.
|
Цитата:
Цитата megaloman
но при просмотре ячейки по F2 апостроф перед числом виден. Я посчитал это некорректным. »
|
Шут его знает. В концепции Microsoft Excel — это вполне официальный и поддерживаемый способ, идущий от начала времён (ещё до-Excel'евских). В возвращаемом значении свойств .Value, .Value2, .Text апостроф не показывается, он учитывается отдельным свойством .PrefixCharacter, так уж сложилось исторически:
При экспорте, например, в CSV или в TSV, эти апострофы не сохраняются, тип данных (строка, а не число) теряется. При экспорте в xml апострофы также не сохраняются, тип данных сохраняется. |
Код:
Range("A1") = "1234567" 'Формат ячейки общий
Range("A2") = "'1234567" 'Формат ячейки общий
MsgBox Range("A1") = Range("A2") ' Получим False
MsgBox CStr(Range("A1")) = CStr(Range("A2")) ' Получим True
Range("C1") = "1234567" 'Формат ячейки общий
Range("C2") = "1234567" 'Формат ячейки текстовый
MsgBox Range("C1") = Range("C2") ' Получим False
MsgBox CStr(Range("C1")) = CStr(Range("C2")) ' Получим True
|
megaloman, дык, про что и речь, ибо:
Код:
Option Explicit
Sub Sample()
Range("A1").Value = "1234567"
Range("A2").Value = "'1234567"
Debug.Print Range("A1").Value = Range("A2").Value
Debug.Print TypeName(Range("A1").Value)
Debug.Print TypeName(Range("A2").Value)
End Sub
|
Время: 21:31.
© OSzone.net 2001-
