Skripta naj bi vnesla podatke iz txt datoteke. Podatki, ki še niso bili vnešeni v Excel so od podatkov, ki so bili že vnešeni v excel ločeni z prazno vrstico in delimiter je v primeru že vnešenih podatkov tabulator, v primeru nevnešenih podatkov pa ";". Torej ko so podatki vnešeni v Excel se delimiter spremeni v tabulator. Imam možnost avtomatskega prenosa ali pa ročnega (da pokaže podatke, ampak jih je potem potrebno ročno kopirati)
Skripta ne deluje v primeru, da podatkov še nikoli nisem prenesel v Excel in sicer so opazke sledeče:
V txt datoteki imam 1 vrstico podatkov: prikaže 1 vrstico podatkov (ročno), ampak avtomatski prenos ne deluje (ni novih podatkov). Tudi delimiter se ne spremeni v tabulator, torej txt datoteka ostane nespremenjena.
V txt datoteki imam 2 vrstici podatkov: prikaže 2 vrstici podatkov (ročno), ampak avtomatski prenos ne deluje (ni novih podatkov). Tudi delimiter se ne spremeni v tabulator, torej txt datoteka ostane nespremenjena.
V txt datoteki imam 3 vrstice podatkov: Prikaže 3 vrstice podatkov (ročno), avtomatsko prenese le prvo vrstico podatkov. Pravilno izpiše koliko vrstic podatkov se je vpisalo. TXT datoteka se spremeni, torej delimiter je za vse 3 vrstice podatkov sedaj tabulator (dejansko izgubim potem 2 in 3 vrstico podatkov)
V txt datoteki imam 4 ali več vrstic podatkov: Prikaže in prenese vse podatke pravilno toda vedno izpiše za število 2 manj vnešenih vrstic podatkov. Delimiter se v txt datoteki spremeni na tabulator.
Če po prvem vnosu v Excel ko se txt datoteka spremeni, ponovno pišem nove podatke v txt datoteko in želim kasneje nove podatke avtomatsko prenesti v Excel, pa deluje vse OK, ne glede na to ali imam 1,2,3 ali več novih vrstic podatkov. Tudi štetje je potem pravilno.
Ugotovil sem, da če v txt datoteko, preden prvič vnašam podatke v Excel v prve 3 vrstice dodan 0 (podatki morajo biti že vpisani) in nato prazno vrstico in potem podatke (simuliram kakor da sem že vnašal podatke v Excel) deluje vse OK.
Podatke pišem v txt datoteko z nekim drugim programom.
Txt datoteka in Ecxel ne smeta imeti istega imena datoteke!
Primer podatkov (txt datoteka), v tem primeru bo skripta vnesla le 1 vrstico s podatki)
prazna vrstica
1;5;2;1;1
1;5;2;1;2
1;5;2;1;3
Koda: Izberi vse
Attribute VB_Name = "Module1"
Sub Avto_prenos()
'macro za avtomatsko kopiranja podatkov By TA
Windows("test_vnos.xlsm").Activate
If ActiveWorkbook.ReadOnly Then
GoTo 4
End If
Dim MyPassword As String
MyPassword = "1234"
If InputBox("Prosim vpišite geslo za prenos podatkov.", "Vpis gesla") <> MyPassword Then
Exit Sub
End If
response = MsgBox("Ali boš prenesel podatke avtomatsko?", vbYesNo)
If response = vbNo Then GoTo 5
Workbooks.OpenText Filename:= _
"C:\TXT\test.txt", _
Origin:=852, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
Dim lastrow As Integer
lastrow = Range("A" & Rows.Count).End(xlUp).Row
'MsgBox lastrow
Selection.End(xlDown).Select
Range(Selection, Selection.EntireRow).Select
Dim vrsta As Integer
vrsta = ActiveCell.Row
'MsgBox vrsta
On Error GoTo 2
Range("A:A").SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
Range(Selection, Selection.EntireRow).Select
X = lastrow - vrsta
If X = 2 Then
GoTo 1
ElseIf X < 2 Then
GoTo 2
End If
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.EntireRow).Select
1
Dim var1 As String
var1 = (X - 1)
Selection.Copy
Windows("test_vnos.xlsm").Activate
Cells(Rows.Count, 1).End(xlUp).Offset(1).Select
On Error GoTo 3
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Windows("test.txt").Activate
ActiveWorkbook.Close SaveChanges:=True
Windows("test_vnos.xlsm").Activate
If var1 = 1 Then
MsgBox "KOPIRALI STE " + var1 + " PODATEK!"
ElseIf var1 = 2 Then
MsgBox "KOPIRALI STE " + var1 + " PODATKA!"
ElseIf var1 > 2 And var1 < 5 Then
MsgBox "KOPIRALI STE " + var1 + " PODATKE!"
ElseIf var1 > 4 Then
MsgBox "KOPIRALI STE " + var1 + " PODATKOV!"
End If
Exit Sub
2
MsgBox "NI PODATKOV ZA PRENOS!"
Windows("test.txt").Activate
ActiveWorkbook.Close SaveChanges:=False
Exit Sub
3
MsgBox "NE MOREM KOPIRATI, ODKLENI PODATKE!!!"
Windows("test.txt").Activate
Application.CutCopyMode = False
ActiveWorkbook.Close SaveChanges:=False
Exit Sub
4
MsgBox "NEKDO IMA ODPRTE PODATKE-(read only)!"
Windows("test_vnos.xlsm").Activate
Exit Sub
5
Workbooks.OpenText Filename:= _
"C:\TXT\test.txt" _
, Origin:=852, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
TrailingMinusNumbers:=True
Cells(Rows.Count, 1).End(xlUp).Offset(1).Select
End SubTrenutno je bilo zamišljen vnos podatkov po zgornjem opisu, če pa bi bila kakšna drugačna rešitev bolj optimalna pa ne vem. Zahteva je, da se podatki v TXT datoteki ne brišejo, v excel pa se (ko to zahtevam s klikom na gumb, ki požene skripto) vpišejo le novi podatki (tisti ki še niso vpisani v Excel).
Hvala in LP.