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 Sub
Trenutno 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.