Excel-VBA import Vyřešeno

[Dieesels]

Dobrý den, jak to upravit (viz.níže), aby se data importovala do aktivního sešitu na určitý list ?

Kód: Vybrat vše

Option Explicit

Sub Import()
Dim MsgResponse, MsgTit As String
Dim ImportFirstFile As Boolean, ImportDir As String, ImportFile As String
Dim ZdrojSoubor As Workbook, ZdrojList As Worksheet, ListData As String, ZdrojAdresa As String
Dim ZdrojOblast As Range, c As Range
Dim CilOblast As Range, i As Integer, j As Integer
  MsgTit = "Import dat"
  ImportFirstFile = True ' identifikace prvniho souboru v adresari
  ImportDir = "E:\excel" ' cesta k souborum
  ZdrojAdresa = "a1,b2,c3:d4,f5" ' adresy bunek se zdrojovymi daty
  Set CilOblast = ActiveWorkbook.Worksheets("list1").Range("a1")
  Application.ScreenUpdating = False
  j = 0 ' ofset radku na cilovem listu
  Do
    If ImportFirstFile Then
      ImportFile = Dir(ImportDir & "\*.xls") ' prvni soubor v adresari
      If ImportFile = "" Then _
        MsgResponse = MsgBox("Adresáø souborù: '" & ImportDir _
        & "' k importu je prázdný!", _
        vbOKOnly + vbInformation, MsgTit): Exit Do
      ImportFirstFile = False
    Else
      ImportFile = Dir ' dalsi soubory v adresari
    End If
    If ImportFile = "" Then _
      MsgResponse = MsgBox("V adresáøi souborù: '" & ImportDir _
      & "' k importu nejsou další soubory!", _
      vbOKOnly + vbInformation, MsgTit): Exit Do
      '
      MsgBox ImportFile ' pouze pro test
      '
      ListData = "list1" ' algoritmus prirazeni nazvu zdrojoveho listu dle souboru
      '
      Set ZdrojSoubor = Workbooks.Open(ImportDir & "\" & ImportFile) ' otevrit soubor
      Set ZdrojList = ZdrojSoubor.Worksheets(ListData)
      Set ZdrojOblast = ZdrojList.Range(ZdrojAdresa)
      i = 0 ' ofset sloupcu na cilovem listu
      For Each c In ZdrojOblast.Cells
        CilOblast.Offset(j, i).Value = c.Value
        i = i + 1 ' dalsi sloupec na cilovem listu
      Next c
      ZdrojSoubor.Close
      j = j + 1 ' dalsi radek na cilovem listu
  Loop ' dalsi soubor
  Application.ScreenUpdating = True
End Sub

[Reklama]

[mike007]

Stačí změnit nastavení oblasti :
Set CilOblast = ActiveWorkbook.Worksheets("list1").Range("a1")

[Dieesels]

Mohl by jste to upřesnit, nemyslím import do jiného listu, ale stávajícího sešitu. To znamená, toto makro mám např. v sešitu1, po spuštění procedury se importují data ze sešitu2 do právě otevřeného sešitu1 do určitého listu.

[Dieesels]

Nikoho nic nenapadá?...

[navstevnik]

Uvedena procedura umistena v modulu aktivniho sesitu slouzi k importu dat do tohoto sesitu na list, jehoz nazev je v procedure - Set CilOblast = ActiveWorkbook.Worksheets("list1").Range("a1")-, z vice sesitu, kde data jsou v techto sesitech na listech se stejnym nazvem a ve stejnych bunkach.
Pozadujes "aby se data importovala do aktivního sešitu na určitý list " a to prave procedura vykonava.
Zkus prosim precizneji formulovat pozadavek.
PS.Koukni se sem, jak importovat data: http://excelplus.net./news.php?readmore=20

[mike007]

Data by se ti měly importovat do aktivního sešitu, nejde to snad? Co ti hází za chybu?
Vyzkoušel jsem ho u sebe a nic neobvyklého jsem nezpozoroval.

Ve složce E:\excel by měl/y být umístěn/y soubor/y s daty, které se mají po spuštění makra importovat do sešitu.
Takže když si vytvoříš excelový dokument, nakopíruješ do něj makro a spustíš ho, data ze složky E:\excel se importují do tvého sešitu. Nic dalšího makro neumí.

[Dieesels]

Děkuji za pomoc. Už to jde. Problém byl mezi klávesnicí a židlí. Ještě jednou díky za strávený čas nad problémem a trpělivost...

[Dieesels]

Ještě jeden dotaz týkající se importu. V přiloženém souboru je makro, které opět importuje data z databanka.xls, do import.xls sheet2. Vše funguje makro je funkční, jen když změním koncovku, aby se importovala data místo databanka.xls, tak databanka.csv...to znamená jiný formát. Tak to nelze. Jak na to?...Je to poslední dotaz co se týče importu dat.

[navstevnik]

Pro import souboru *.csv pouzij nasledujici proceduru:

Kód: Vybrat vše

Option Explicit

Sub InputCsvFile(ByVal CestaSoubor As String, ByVal Wsht As Worksheet)
' oddelovac polozek je ";"
  Dim Blok As Range, Cll As Range
  ' nacteni souboru do listu - QueryTables
  With Wsht.QueryTables.Add(Connection:="TEXT;" & CestaSoubor, _
      Destination:=Range("A1"))
    .TextFileCommaDelimiter = False
    .Refresh BackgroundQuery:=False
  End With
  ' nasledujici cast procedury aktivovat, kdyz desetinny oddelovac cisel je "."
  '
  ' definovat blok pro prevod cisel z textoveho tvaru na cislo
'    With Wsht
'      Set Blok = .Range(.Range("c2"), .Range("c2").End(xlDown))
'    End With
'    ' format bunky a prevod
'    For Each Cll In Blok
'      Cll.NumberFormat = "0.00"
'      Cll.Value = CDbl(Val(Cll.Value))
'    Next Cll
End Sub

' testovaci procedura pro volani InputCsvFile
Sub TestInputCsvFile()
  Dim CestaSoubor As String, Wsht As Worksheet
  ' cesta a soubor, lze nacist i z listu, napr: CestaSoubor =Worksheets("list1").Range("A1")
  CestaSoubor = "e:\excel\databanka.csv"
  ' list pro ulozeni dat
  Set Wsht = Worksheets("list2")
  Wsht.Activate
  Wsht.UsedRange.ClearContents
  InputCsvFile CestaSoubor, Wsht
End Sub

Snad to vyresi tve trable s nacitanim souboru *.csv

[Dieesels]

Nevím co říct. Konečně mám vše co jsem potřeboval co se týče importu dat .Opět vám za to děkuji.

[navstevnik]

Variantni reseni:

Kód: Vybrat vše

Option Explicit

Sub InputCsvFile1(ByVal CestaSoubor As String, TargetCll As Range)
  Dim Str As String, PoleTemp
  Dim i As Long, j As Integer

  Open CestaSoubor For Input As #1
  If Not EOF(1) Then
    i = 0
    Do
      Line Input #1, Str
      PoleTemp = Split(Str, ";")
      j = 0
      Do
        If IsNumeric(PoleTemp(j)) Then
          TargetCll.Offset(i, j).Value = CDbl(Val(PoleTemp(j)))
          TargetCll.Offset(i, j).NumberFormat = "0.00"
        Else
          TargetCll.Offset(i, j).Value = PoleTemp(j)
        End If
        j = j + 1
      Loop While j <= UBound(PoleTemp)
      i = i + 1
    Loop While Not EOF(1)
  End If
  Close #1
End Sub

Sub TestInputCsvFile1()
  Dim CestaSoubor As String, TargetCll As Range
  CestaSoubor = "e:\excel\databanka.csv"
  ' ulozit do:
  Set TargetCll = Worksheets("list3").Range("a1")
  InputCsvFile1 CestaSoubor, TargetCll
End Sub

[Dieesels]

Ta druhá varianta byl dobrý nápad.