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

• #2870 Bazs87 tag Bazs87 #2869

  Új Válasz 2017-06-08 15:37:48 #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