[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

Возможный результат

Исходный файл указывается аргументом скрипта (также можно просто перетянуть файл из Проводника на скрипт). Всё, что я писал Вам ранее в этой теме: CMD/BAT - [решено] CMD/BAT - Скрипт, который считывает количество данных из разных таблиц Excel касательно окружения исполнения — будет справедливо и здесь.

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