Favicon Svetmobilne.cz  Svět mobilně Favicon Svetaudia.cz  Svět audia Favicon TVFreak.cz  TV Freak   Fórum Favicon Digimanie.cz  Digimanie   Fórum   Galerie Společnost oXy Online s.r.o.
Zobrazené výsledky: 1 až 3 z 3

Téma: Excel, makro - import údajov

  1. #1
    Nováček
    Registrace
    Dec 2007
    Příspěvků
    3

    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ý
    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
    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/2b45b4357...3b21ebb42.html
    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
    Diki za každú pomoc.
    Odpovídat lze po přihlášení

  2. #2
    Nováček
    Registrace
    Dec 2007
    Příspěvků
    3

    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.

    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
    Naposledy upraveno uživatelem kanec1111: 04-06-2010 v 15:07
    Odpovídat lze po přihlášení



  3. #3
    Nováček
    Registrace
    Dec 2007
    Příspěvků
    3

    Hotovo

    Kód:
    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
    Odpovídat lze po přihlášení

Podobná témata

  1. import vcard do androidu
    Od kanabis v sekci Problémy s PC (HW/SW) a řešení
    Reakcí: 2
    Poslední příspěvek: 24-05-2011, 15:20
  2. Microsoft Office: Outlook 2007 - import
    Od pyroozzy v sekci Kancelářské balíky
    Reakcí: 1
    Poslední příspěvek: 10-01-2011, 20:46
  3. Microsoft Office: makro v excelu 2003
    Od pepeko v sekci Kancelářské balíky
    Reakcí: 2
    Poslední příspěvek: 16-07-2010, 00:40
  4. Microsoft Office: excel - napiše mi někdo makro?
    Od Dubák v sekci Kancelářské balíky
    Reakcí: 1
    Poslední příspěvek: 27-03-2009, 15:57
  5. Makro v Exceli
    Od MaxMan v sekci Programování
    Reakcí: 3
    Poslední příspěvek: 15-05-2008, 13:15