[решено] Изменения значения столбца в xls

[romfus]

Добрый день. Имеется файл в 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

[romfus]

В Данном файле что я прикрепил нет таких индексов. Но для проверки например 403995 изменить на 403996 Я поэтому примеру сделаю на другие нужные мне индекса

[Iska]

romfus, можно считывать, можно менять. Главный вопрос — по какому принципу?

[romfus]

ну как понять по какому принципу? запускаю скрипт, этот скрипт в папке находит этот xls ( он один там ) считывает в этом xls стоблец b1. Если находит в нем 403995 изменяет на 403996 затем как все считал закрыл этот xls и сохранил.

[Iska]

romfus, откуда скрипт узнает, что нужно искать 403995, и откуда скрипт узнает, что менять нужно на 403996? Откуда скрипт узнает, что нужно искать 368200, и откуда скрипт узнает, что менять нужно на 368211? И т.д.

[romfus]

а в 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 то я ее меняю

[megaloman]

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 "Скрипт завершен"
Имя файла можно указать прямо в скрипте, либо сделать на скрипт значок на раб. столе и затягивать мышкой на него обрабатываемый файл, при этом имя явно указанного в скрипте файла будет проигнорировано.

[romfus]

А форматирование оригинального файла этот скрипт может сохранить? а то он заменяет текст а форматирование меняется

[Iska]

Мой вариант — на базе 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
https://i.imgur.com/Nk7ozHJ.png
Исходный файл указывается аргументом скрипта (также можно просто перетянуть файл из Проводника на скрипт). Всё, что я писал Вам ранее в этой теме: CMD/BAT - [решено] CMD/BAT - Скрипт, который считывает количество данных из разных таблиц Excel (http://forum.oszone.net/thread-334404.html) касательно окружения исполнения — будет справедливо и здесь.

[megaloman]

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
...............

[Iska]

megaloman, полагаю, если вставлять как текст:
.Range(RangeIn).Offset(i, 0).Value = "'" & CStr(NRepl(j + 1))
— выравниваться вправо не будет (не проверялось).

[megaloman]

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)) здесь не нужно, элементы этого массива изначально записывались как литералы.
Я не проверял решение в случае, если замены надо делать не со строками, которые можно интерпретировать как число, а как голимые литералы. Подозреваю, и в этом случае скрипт будет работать.

[Iska]

но при просмотре ячейки по F2 апостроф перед числом виден. Я посчитал это некорректным. »
Шут его знает. В концепции Microsoft Excel — это вполне официальный и поддерживаемый способ, идущий от начала времён (ещё до-Excel'евских). В возвращаемом значении свойств .Value, .Value2, .Text апостроф не показывается, он учитывается отдельным свойством .PrefixCharacter, так уж сложилось исторически:

https://i.imgur.com/2nCt8Tf.png

При экспорте, например, в CSV или в TSV, эти апострофы не сохраняются, тип данных (строка, а не число) теряется. При экспорте в xml апострофы также не сохраняются, тип данных сохраняется.

[megaloman]

Шут его знает. »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

[Iska]

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

False
Double
String