2. Fórumok
  3. Szoftverfejlesztés
  4. Visual Basic

Új hozzászólás Aktív témák

  • #2870 Bazs87 tag Bazs87 #2869
    Új Válasz #2870
    Új hozzászólás
    Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra
    Privát üzenet küldése

    Bazs87

    tag

    válasz Bazs87 #2869 üzenetére

    RITKÁN, de van hogy a lustaság nem kifizetődő

    így már a tesztejim szerint működik:

    xlsx_dict = "U:\6_798\Translate\v01\pl.xlsx"
    xlsx_trgt = "U:\6_798\Translate\v01\TIAProjectTexts_mod.xlsx"

    Set fso = CreateObject( "Scripting.FileSystemObject" )
    Set wobu = CreateObject("Scripting.Dictionary")


    Set objExcel = CreateObject("Excel.Application")

    if not fso.FileExists(xlsx_dict) then
    MsgBox xlsx_dict + " nicht gefunden"
    WScript.Quit()
    end if

    if not fso.FileExists(xlsx_trgt) then
    MsgBox xlsx_trgt + " nicht gefunden"
    WScript.Quit()
    end if

    objExcel.WorkBooks.Open xlsx_dict
    Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

    'dict aufladen
    for i=1 to 532
    tmp1 = cStr(objSheet.Cells(i,1).Value)
    tmp2 = cStr(objSheet.Cells(i,2).Value)

    tmp1 = Replace(tmp1,vbcrln,"</\>")
    tmp2 = Replace(tmp2,vbcrln,"</\>")

    if not wobu.exists(tmp1) then
    wobu.add tmp1, tmp2
    else
    'MsgBox "Problem mit key: " + tmp1
    end if
    next

    objExcel.ActiveWorkbook.Save
    objExcel.ActiveWorkbook.Close


    objExcel.WorkBooks.Open xlsx_trgt
    Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

    'Übersetzen
    for i=2 to 24257
    dtext = objSheet.Cells(i,5).Value

    dtext = Replace(dtext,vbcrln,"</\>")

    if wobu.exists(dtext) then
    tmp = Replace(wobu(dtext),"</\>",vbcrln)
    objSheet.Cells(i,6).Value = tmp
    else
    '
    end if
    next

    objExcel.ActiveWorkbook.Save
    objExcel.ActiveWorkbook.Close


    objExcel.Application.Quit

    Set objSheet = nothing
    set objExcel = nothing
    Set wobu = nothing
    Set fso = nothing

    msgBox "Fertig"

Új hozzászólás Aktív témák