VBS [VBS] Скрипт передачи данных из одной книги в другую

Тема в разделе "Visual Basic 6 / Сценарии VBScript, JScript", создана пользователем kirk2011, 17 июл 2017.

  1. kirk2011

    kirk2011 Новый пользователь

    Сообщения:
    3
    Симпатии:
    0
    Здравствуйте, нужен скрипт который перекидывает данные с полей одного объекта в другой(otkuda->kuda)
    поля:
    number postavki->№ поставки
    company->фирма
    rashifrovka-> наименование
     

    Вложения:

    • kuda.xlsx
      Размер файла:
      10,1 КБ
      Просмотров:
      4
    • otkuda.xlsx
      Размер файла:
      9 КБ
      Просмотров:
      4
  2. Dragokas

    Dragokas Very kind Developer Команда форума Супер-Модератор Разработчик Клуб переводчиков

    Сообщения:
    5.337
    Симпатии:
    5.239
    Здравствуйте, kirk2011 !

    Добро пожаловать на SafeZone !

    Вопрос:
    1. Если от одной и той же фирмы будут указаны разные комплектующие (например, сис. блок + ноутбук), то их нужно в одной строке записывать или в разных?
    2. Эти книги всегда открыты / всегда закрыты / или состояние неопределённое ?
     
    akok нравится это.
  3. kirk2011

    kirk2011 Новый пользователь

    Сообщения:
    3
    Симпатии:
    0
    1. Можно в одной строке.
    2. Закрытые
     
  4. kirk2011

    kirk2011 Новый пользователь

    Сообщения:
    3
    Симпатии:
    0
    Главное чтобы ячейки исходника и адресата привязаны были.
     
  5. Dragokas

    Dragokas Very kind Developer Команда форума Супер-Модератор Разработчик Клуб переводчиков

    Сообщения:
    5.337
    Симпатии:
    5.239
    kirk2011, сделал по-проще, без обработки дубликатов.

    Код (vb.net):
    Option Explicit

    Dim oBook1, oBook2, oExcel, sBookSource, sBookDest

    sBookSource = "h:\_VBA\_Transfer\otkuda.xlsx"
    sBookDest = "h:\_VBA\_Transfer\kuda.xlsx"

    set oExcel = GetExcel()

    'oExcel.Visible = true

    set oBook1 = oExcel.Workbooks.Open(sBookSource)
    set oBook2 = oExcel.Workbooks.Open(sBookDest)

    call Processing(oBook1, oBook2)

    oBook1.Close (false)
    oBook2.Close (true)

    oExcel.Quit

    WScript.Echo ("finished")

    Sub Processing(oBook1, oBook2)
        Const xlCellTypeLastCell = 11
        Const xlUp = -4162

        Dim Sy, oSh1, oSh2, sCol
        Dim Dy, n

        Set oSh1 = oBook1.Worksheets(1)
        Set oSh2 = oBook2.Worksheets(1)
       
        'очистка листа-назначения
        oSh2.Range(oSh2.Range("A3"), oSh2.UsedRange.SpecialCells(xlCellTypeLastCell)).ClearContents
       
        Dy = 2
        For Sy = 2 To oSh1.Cells(oSh1.Cells.Rows.Count, 1).End(xlUp).Row
            n = n + 1
            oSh2.Cells(Dy + n, oSh2.Columns("A").Column).Value = n                                              '№ п/п
            oSh2.Cells(Dy + n, oSh2.Columns("D").Column).Value = oSh1.Cells(Sy, oSh2.Columns("A").Column).Value 'фирма
            oSh2.Cells(Dy + n, oSh2.Columns("B").Column).Value = oSh1.Cells(Sy, oSh2.Columns("E").Column).Value '№ поставки
            Select Case LCase(Trim(oSh1.Cells(Sy, oSh2.Columns("B").Column).Value)) 'vid_tech
            Case "системный блок": sCol = "G"
            Case "ноутбук": sCol = "H"
            Case "монитор": sCol = "I"
            Case "манипулятор": sCol = "J"
            Case Else: MsgBox "Вид техники не определён: позиция " & n
            End Select
            if sCol <> "" then
                oSh2.Cells(Dy + n, oSh2.Columns(sCol).Column).Value = oSh1.Cells(Sy, oSh2.Columns("C").Column).Value 'расшифровка
            end if
        Next
    End Sub

    Function GetExcel()
        on error resume next
        set GetExcel = GetObject("","Excel.Application")
        if Err.Number <> 0 then
            Err.Clear
            set GetExcel = CreateObject("Excel.Application")
            if Err.Number <> 0 then
                WScript.Echo ("Не могу открыть программу Microsoft Excel!")
                WScript.Quit (1)
            end if
        end if
    End Function
     
    akok нравится это.
Загрузка...

Поделиться этой страницей

Загрузка...