Excel, makro - import údajov

kanec1111 (3)|3.6.2010 20:58

Hojte, potrebujem poradiť ohladom makra v exceli (office 2007).
Potrebujem spraviť import série txt súborov ... nazvaných: vM_01, vM_02 až vM_xy (maximum cca vM_30)

obsah importovaných súborov je takýto a potrebujem len druhý údajový stĺpec, počet údajov je rovnaký
[QUOTE]xy data
-170 0.73828504
-150 0.523211284
-130 0.175759889
-110 0.357891744
-90 0.827888931
-70 0.36866269
-50 0.300959106
-30 0.012137155
-10 0.238066871
10 0.386030465
30 0.186901046
50 0.876816737
70 0.365455703
90 0.977813206
110 0.937658776
130 0.037790291
150 0.73603417
170 0.254814215[/QUOTE]

potrebujem to importovať do stĺpcov v excelovom hárku vedľa seba,

a potrebujem urobiť 2 veci:
1.) zautomatizovať - spraviť slučku (nie ako je to v príklade nižšie)
2.) a aby to fungovalo v každom priečinku nie iba "C:\Documents and Settings\k\Desktop\makro\" ... tuším že sa to volá "relative path" ale nie som si istý??? - v každom prípade je excel súbor a dátové súbory v tom istom adresáre

čo som zvládol urobiť je nižšie a mohol by som pokračovať až do 30:
tu je vzorka dát a čo som zatiaľ spravil: http://www.upnito.sk/subor/2b45b435737dcb3444c282d3b21ebb42.html
[QUOTE]Sub import()
' import Makro
' vynulovať pole B5:N22
Range("B5:N22").Select
Selection.ClearContents
' import 01
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Documents and Settings\k\Desktop\makro\vM_01.", Destination:=Range( _
"$B$5"))
.Name = "vM_01."
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 852
.TextFileStartRow = 2
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(9, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
' import 02
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Documents and Settings\k\Desktop\makro\vM_02.", Destination:=Range( _
"$C$5"))
.Name = "vM_02."
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 852
.TextFileStartRow = 2
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(9, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
' import 03
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Documents and Settings\k\Desktop\makro\vM_03.", Destination:=Range( _
"$D$5"))
.Name = "vM_03."
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 852
.TextFileStartRow = 2
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(9, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub[/QUOTE]

Diki za každú pomoc.

kanec1111 (3)|4.6.2010 15:01

Skoro to už mám ....

spravil som makro ako je nižšie ktoré:
1.) po spustení sa otvorí okno pre výber vstpného údaja - open file
2.) vymazanie obsahu buniek - clear data
3.) import dát zo súbotu - import data

čo mi tam chýba je slučka pre časť "import data" ktorá:
1.) zmení koniec premennej "fileToOpen" z vM_01 na vM_02, vM_03 .... atď
2.) zmení požadovaný stĺpec - Destination:=Range("$B$8") z B na C, D ... atď

Viem že slučka sa dá jednoducho spraviť pomocou "for" čo by nebol problem ... avšak problem je ako zmeniť premenné fileToOpen a Range.

[quote]Sub open_text()
' open file
fileToOpen = Application _
.GetOpenFilename("Text Files (*.*), *.*")
If fileToOpen <> False Then
MsgBox "" & fileToOpen
End If
' clear data
Range("B8:X55").Select
Selection.ClearContents
' import data
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & fileToOpen, _
Destination:=Range("$B$8"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 852
.TextFileStartRow = 2
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(9, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub[/quote]

kanec1111 (3)|4.6.2010 20:44

Hotovo :)

[code]Sub open_text()
' defining variables
Dim nText As Long
Dim i As Integer
Dim x As Integer
Dim fileToOpen2 As String
' open file
fileToOpen = Application _
.GetOpenFilename("Text Files (*.*), *.*")
' data preparing
nText = Len(fileToOpen)
nText = nText - 3
fileToOpen = Left(fileToOpen, nText)
' print the path
Range("$E$1") = fileToOpen
' clear field of data
Range("B5:AE22").Select
Selection.ClearContents
' import data
For i = 1 To 30
If i < 10 Then
fileToOpen2 = fileToOpen & "0" & i & "."
Else
fileToOpen2 = fileToOpen & i & "."
End If
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & fileToOpen2, _
Destination:=Cells(5, i + 1))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 852
.TextFileStartRow = 2
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(9, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Next i
End Sub[/code]