Új hozzászólás Aktív témák

• #1703 nagy.aa csendes tag

  Új Válasz 2006-11-01 07:44:23 #1703

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  nagy.aa

  csendes tag

  Már nem is tudom, hogy hol , de lapa megoldása volt ez :
  Option Explicit
  
  Sub export()
  
  Dim elso, masodik, harmadik, negyedik, otodik, hatodik, hetedik As String
  Dim fold As FileDialog
  Dim foldrv As Variant
  Dim fso As Object
  Dim fajllista As FileSearch
  Dim fajllistaindex As Long
  Dim forras, cel As String
  
  Application.Calculation = xlCalculationManual
  Application.ScreenUpdating = False
  
  cel = ActiveWindow.Caption
  
  Set fold = Application.FileDialog(msoFileDialogFolderPicker)
  
  With fold
  If .Show = -1 Then
  foldrv = .SelectedItems(1)
  Else
  Exit Sub
  End If
  End With
  
  Set fajllista = Application.FileSearch
  
  With fajllista
  .NewSearch
  .LookIn = foldrv
  .Filename = ''*.xls''
  .SearchSubFolders = False
  If .Execute > 0 Then
  For fajllistaindex = 1 To .FoundFiles.Count
  'MsgBox .FoundFiles(fajllistaindex)
  Workbooks.Open Filename:=.FoundFiles(fajllistaindex)
  
  forras = ActiveWindow.Caption
  
  ' első fül A1 cella
  Workbooks(cel).Sheets(1).Cells(fajllistaindex, 1) = Workbooks(forras).Sheets(1).Cells(1, 1)
  ' első fül B1 cella
  Workbooks(cel).Sheets(1).Cells(fajllistaindex, 2) = Workbooks(forras).Sheets(1).Cells(1, 2)
  Workbooks(cel).Sheets(1).Cells(fajllistaindex, 3) = Workbooks(forras).Sheets(1).Cells(1, 3)
  Workbooks(cel).Sheets(1).Cells(fajllistaindex, 4) = Workbooks(forras).Sheets(1).Cells(1, 4)
  Workbooks(cel).Sheets(1).Cells(fajllistaindex, 5) = Workbooks(forras).Sheets(1).Cells(1, 5)
  Workbooks(cel).Sheets(1).Cells(fajllistaindex, 6) = Workbooks(forras).Sheets(1).Cells(1, 6)
  Workbooks(cel).Sheets(1).Cells(fajllistaindex, 7) = Workbooks(forras).Sheets(1).Cells(1, 7)
  '(fajllistaindex, 1) = workbooks(
  
  Application.DisplayAlerts = False
  Workbooks(forras).Close
  Application.DisplayAlerts = True
  
  '''=[Book1.xls]Sheet1!R1C1''
  '''=['' & .FoundFiles(fajllistaindex) & ''Sheet1!R1C1''
  
  Next fajllistaindex
  End If
  End With
  
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
  Application.Calculate
  
  MsgBox ''készen vagyunk. összesen '' & fajllistaindex & '' fájlból importáltunk adatokat.'', vbInformation + vbOKOnly, ''köszönjük, hogy minket választott''
  
  End Sub
  
  
  
  
  Nos most valami ilyesmire lenne szükségem, viszon az kellene, hogy a táblákból ne csak az elsősor adatait importálja, hanem minden adatot! Annyi cifrával, hogy van mindben egy oszlop ami úgymond a kulcs, tehát ha mindkettőben talál ilyet akkor csak az egyikből vegye, kétszer ne szerepeljen ua. a sor csak az elérő oszlop tartalmat importálja a meglévőhöz!
  Remélem érthető voltam?!
  
  Kérlek segítsetek!

Új hozzászólás Aktív témák