Как в VBS для Excel сделать автокоррекцию данных с поиском сопоставления в массиве?

Question

[domanskiy]

Есть экселевский файл, где в некоторых ячейках (допустим в B13:B22) вносятся названия красок. Есть скрипт на VBS который экспортит данные в XML.
Оператор забивает названия в виде примерно таком P485 или 485 или P485C
А нужно что бы было конкретно PANTONE 485 С

Или он вбивает FefBlue или Reflex
А нужно что бы было конкретно PANTONE Reflex Blue С

Есть весь список используемых красок с названиями как оно должно быть.
Но мне кажется, нужно просто сделать условие проверки
Как сделать проверку и изменение данных?

Код сейчас такой
Set objElem = objDoc.createElement("Ink")
objElem.setAttribute "ColorName", Cells(1, 2)

Answer 1

[Пычев Анатолий]

Я думаю это надо делать в самом excel файле в макросах
По событию изменения соответствующей ячейки делать поиск в списке и изменять ее же снова

Для помощи по vbs нужен более полный код

Answer 2

[domanskiy]

Т.е. человек набирает в ячейке 485, а макрос автоматически подставляет PANTONE 485 C ?
Как это реализуется?
Сейчас у меня макрос запускается через панель запуска макрасов в Экселе.

Сейчас код такой:

Const strFilePath As String = "Y:\TEMP-Shuttle-IN\Blank_v1.xml"



Sub MyXLS2XML()


    Dim arRound As Integer
    Dim objDoc As MSXML2.DOMDocument
    Dim objNode As MSXML2.IXMLDOMNode
    Dim objRoot As MSXML2.IXMLDOMElement
    Dim objElem As MSXML2.IXMLDOMElement
    Dim ar As Variant
    Dim i As Integer
    
'    Для подсчёта новых форм
Dim val As String
Dim val1 As String
Dim r As Range
Dim SummNewForm As Integer
Set r = Range("E13:E22") 'диапазон ячеек
    
'Массив значений для сравнения
Dim MyArray
MyArray = Array("нов", "новая", "нов.")
 

    
    Set objDoc = New DOMDocument
    objDoc.resolveExternals = True
    Set objNode = objDoc.createProcessingInstruction("xml", "version='1.0' encoding='utf-8'")
    Set objNode = objDoc.InsertBefore(objNode, _
    objDoc.ChildNodes.Item(0))
    Set objRoot = objDoc.createElement("JOB")
    Set objDoc.DocumentElement = objRoot
    
      
             Set objElem = objDoc.createElement("JobNamber")
                  objElem.Text = Range("Номер_заказа")
                  objRoot.appendChild objElem
            
             Set objElem = objDoc.createElement("CustomerName")
                  objElem.Text = Range("Заказчик")
                  objRoot.appendChild objElem


             Set objElem = objDoc.createElement("Substrate")
                  objElem.Text = Range("Тип_материала")
                  objRoot.appendChild objElem

             Set objElem = objDoc.createElement("PrintTech")
                  objElem.Text = Range("Способ_печати")
                  objRoot.appendChild objElem

             Set objElem = objDoc.createElement("ICCprof")
                  objElem.Text = Range("ICC_профиль")
                  objRoot.appendChild objElem

             Set objElem = objDoc.createElement("CutTools")
                  objElem.Text = Range("Номер_штампа")
                  objRoot.appendChild objElem

             Set objElem = objDoc.createElement("LabelSize")
                  objElem.Text = Range("Размер_этикетки")
                  objRoot.appendChild objElem

             Set objElem = objDoc.createElement("LabelPart")
                  objElem.Text = Range("часть_этикетки")
                  objRoot.appendChild objElem

             Set objElem = objDoc.createElement("Winding")
                  objElem.Text = Range("Вариант_намотки")
                  objRoot.appendChild objElem

             Set objElem = objDoc.createElement("Designer")
                  objElem.Text = Range("Дизайнер")
                  objRoot.appendChild objElem

          
            
  i = 13
  Do
  
          
        Set objElem = objDoc.createElement("Ink")
            objElem.setAttribute "ID", Cells(i, 1)
            objElem.setAttribute "ColorName", Cells(i, 2)
            objElem.setAttribute "Frequency", Cells(i, 3)
            objElem.setAttribute "Angle", Cells(i, 4)
            objElem.setAttribute "InkParam", Cells(i, 5)
            objRoot.appendChild objElem
            

            
      i = i + 1
 Loop Until Cells(i, 1) = ""
           
'Подсчёт  количества новых форм. по условию val
           
           SummNewForm = Application.WorksheetFunction.CountIf(r, "*" & MyArray(0) & "*")
             Set objElem = objDoc.createElement("SummNewForm")
                  objElem.Text = SummNewForm
                  objRoot.appendChild objElem




            

        
    'Выполнение XSL-преобразования для добавления отступов в XML
    Call transformXML(objDoc)

    objDoc.Save strFilePath

      End Sub

'Процедура для придания XML читабельного вида (с отступами)
Sub transformXML(ByRef objDoc As Variant)

    'Cоздание объекта XSL
    Set xsl = CreateObject("MSXML2.DOMDocument")
    
    'Загрузка XSL из строки (не требует наличия отдельного XSL-файла)
    xsl.LoadXML ("<xsl:stylesheet version='1.0' xmlns:xsl='http://www.w3.org/1999/XSL/Transform'>" & vbCrLf & _
    "<xsl:output method='xml' version='1.0' encoding='UTF-8' indent='yes'/>" & vbCrLf & _
    "<xsl:template match='@*|node()'>" & vbCrLf & _
    "<xsl:copy>" & vbCrLf & _
    "<xsl:apply-templates select='@*|node()' />" & vbCrLf & _
    "</xsl:copy>" & vbCrLf & _
    "</xsl:template>" & vbCrLf & _
    "</xsl:stylesheet>")
    
    'Выполнение преобразования
    objDoc.transformNodeToObject xsl, objDoc

End Sub

Comments

[h8nor]

https://www.cyberforum.ru/vba/thread1160310.html