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

• #47432 Lasersailing senior tag

  Új Válasz 2021-09-24 12:03:06 #47432

  Ú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

  

  Lasersailing

  senior tag

  Sziasztok,
  
  Előre is elnézést, kicsit hosszú lesz a probléma leírás. Ha van ötletetek, akkor kérlek segítsetek megtalálni a hiba okát!

  Egy üres excel sheetről indultam. A file jelenleg a C: drive-on fut, így is produkálja a hibát, ha hálózaton van, akkor is előjön a hiba. (Hálózati futtatás során az alábbi hiba még read-only státuszt is eredményez, de ezzel ne foglalkozzunk, mert ha az alábbi problémát megoldjuk, akkor a read-only probléma megoldódik.)

  A file-t a makró futtatása előtt ötször lementettem, bezártam, megnyitottam, semmi hibát nem tapasztaltam.

  Excelben lefuttatva egy makrót, majd a file-t elmentve az alábbi hibaüzenet fogad.
  Ha az alábbi makrót lefuttatom, file-t elmentem, majd ismét megnyitom előjön az alábbi hiba:
  
  Yes-re kattintva az alábbi fogad:
  

  A problémát okozó makró:

  A makró alábbi része, gyakorlatilag a trial kitting nevű file-ból átmásol egy táblázatot, közé beszúrva az eredeti excel file-ban található sorokat. Utólag belegondolva, lehet egyszerűbb lenne az egész táblát átmásolni, mögéfűzni az új sorokat, majd az egészet dátum szerint lerendezni. (Mentségemre: nem excel vba-ban tanultam programozni, hanem még turbo pascalban, ott meg ilyen lehetőség nem volt)

  
  Sub trial_kitting_kalkulator()
Dim tke_sm As Integer
Dim tk_sm As Integer
Dim tk_smig As Integer
Dim input_sm As Integer
Dim datum As Date
  

  
  Call rendez

Sheets(TKE).Select
Range("A4").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Delete
Application.ScreenUpdating = False

Workbooks.Open filenev
Windows("Trial kitting.xlsm").Activate
If ActiveSheet.AutoFilterMode Then Selection.AutoFilter
Sheets(SOB).Select
Range("A3:V3").Select
Selection.Copy
Windows("trial kitting kalkulátor.xlsm").Activate
Sheets(TKE).Select
Range("A3").Select
ActiveSheet.Paste

input_sm = 16
tk_sm = 4
tke_sm = 4
Do
  datum = Sheets(bemenet).Cells(input_sm, 9)
  
  'Trial kittingből kimásolja azokat a sorokat, melyek korábbiak, vagy aznapiak
  Windows("Trial kitting.xlsm").Activate
  tk_smig = tk_sm
  While (Sheets(SOB).Cells(tk_smig + 1, 1).Value <= datum)
    tk_smig = tk_smig + 1
  Wend
  'Rows(tk_sm & ":" & tk_smig).Select
  If Not (IsEmpty(Sheets(SOB).Cells(tk_smig + 2, 1).Value)) Then
    datum = Sheets(SOB).Cells(tk_smig + 1, 1).Value
    Else
    datum = "2021/01/01"
  End If
  Range(Cells(tk_sm, 1), Cells(tk_smig, 22)).Select
  Application.CutCopyMode = False
  Selection.Copy
  Windows("trial kitting kalkulátor.xlsm").Activate
  Sheets(TKE).Select
  Cells(tke_sm, 1).Select
  ActiveSheet.Paste
  tke_sm = tk_smig + input_sm - 15
  tk_sm = tk_smig + 1
  

  'Trial kitting előrejelzésbe beírja a szükséges adatokat
  While (Sheets(bemenet).Cells(input_sm, 9).Value < datum) And Not (IsEmpty(Sheets(bemenet).Cells(input_sm, 9)))
    Sheets(TKE).Cells(tke_sm, 1) = Sheets(bemenet).Cells(input_sm, 9)
    Sheets(TKE).Cells(tke_sm, 2) = "Dummy"
    Sheets(TKE).Cells(tke_sm, 3) = "Dummy"
    Sheets(TKE).Cells(tke_sm, 4) = "Dummy"
    Sheets(TKE).Cells(tke_sm, 5) = Sheets(bemenet).Cells(input_sm, 2)
    Sheets(TKE).Cells(tke_sm, 6) = "Dummy"
    Sheets(TKE).Cells(tke_sm, 7) = "Dummy"
    Sheets(TKE).Cells(tke_sm, 8) = "Dummy"
    Sheets(TKE).Cells(tke_sm, 9) = "Dummy"
    Sheets(TKE).Cells(tke_sm, 10) = "Dummy"
    Sheets(TKE).Cells(tke_sm, 11) = Sheets(bemenet).Cells(input_sm, 9)
    Sheets(TKE).Cells(tke_sm, 12) = Sheets(bemenet).Cells(input_sm, 9)
    Sheets(TKE).Cells(tke_sm, 13) = Sheets(bemenet).Cells(input_sm, 7)
    Sheets(TKE).Cells(tke_sm, 14) = "Dummy"
    Sheets(TKE).Cells(tke_sm, 15) = "Dummy"
    Sheets(TKE).Cells(tke_sm, 16) = Sheets(bemenet).Cells(input_sm, 5)
    Sheets(TKE).Cells(tke_sm, 17) = 0
    Sheets(TKE).Cells(tke_sm, 18) = Sheets(bemenet).Cells(input_sm, 5)
    Sheets(TKE).Cells(tke_sm, 19) = "Dummy"
    tke_sm = tke_sm + 1
    input_sm = input_sm + 1
  Wend
'Loop Until (IsEmpty(Sheets(bemenet).Cells(input_sm, 1))) Or datum = "01/01/2021"
Loop Until datum = "01/01/2021"
Application.ScreenUpdating = True

  Van ötletetek, hogy a fenti sorokból mi okozhatj a a file sérülését?

  köszi előre is!

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