Új hozzászólás Aktív témák
-
Bazs87
tag
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
- Székesfehérvár és környéke adok-veszek-beszélgetek
- f(x)=exp(x): A laposföld elmebaj: Vissza a jövőbe!
- A fociról könnyedén, egy baráti társaságban
- Milyen légkondit a lakásba?
- Súlyos adatvédelmi botrányba kerülhet a ChatGPT az EU-ban
- Napelem
- Milyen okostelefont vegyek?
- Fallout 4
- Renault, Dacia topik
- Milyen asztali (teljes vagy fél-) gépet vegyek?
- További aktív témák...