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

• #16989 Delila_1 veterán picsu #16985

  Új Válasz 2013-03-01 10:02:03 #16989

  Ú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

  

  Delila_1

  veterán

  válasz picsu #16985 üzenetére

  Csak utol ne érjen!
  Szívesen segítek máskor is, ha tudok.

• #16955 Delila_1 veterán picsu #16954

  Új Válasz 2013-02-28 14:53:40 #16955

  Ú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

  

  Delila_1

  veterán

  válasz picsu #16954 üzenetére

  Küldd el a cél-, és 2-3 forrás fájlt a címemre. Add meg a mappa elérési útját.

• #16951 Delila_1 veterán picsu #16950

  Új Válasz 2013-02-28 10:38:16 #16951

  Ú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

  

  Delila_1

  veterán

  válasz picsu #16950 üzenetére

  Ha jól értem, egy könyvtárból kiválasztott fájl első lapjának A3:F3 tartományát akarod bemásolni az indító fájl A5:F5 celláiba.

  Sub mm()
  Application.DisplayAlerts = False
  Dim fldlg As FileDialog, utvonal As String
  Dim cel As String, forras As String
  Dim rv, oszlop As Integer
  
  cel = ActiveWindow.Caption
  utvonal = "E:\Eadat\" 'Itt add meg az induló könyvtár útvonalát
  
  Set fldlg = Application.FileDialog(msoFileDialogOpen)
  With fldlg
  .Title = "Megnyitás"
  .InitialFileName = utvonal
  .FilterIndex = 1 '*.xls, vagy *.xlsx
  End With
  
  rv = fldlg.Show
  
  If rv Then
  Workbooks.Open fldlg.SelectedItems(fldlg.FilterIndex)
  forras = ActiveWindow.Caption
  Workbooks(forras).Sheets(1).Range("A3:F6").Copy _
  Workbooks(cel).Sheets(1).Range("A5")
  End If
  Workbooks(forras).Close
  Application.DisplayAlerts = True
  End Sub

• #3542 Delila_1 veterán picsu #3541

  Új Válasz 2008-05-18 08:10:37 #3542

  Ú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

  

  Delila_1

  veterán

  válasz picsu #3541 üzenetére

  Szívesen.

• #3540 Delila_1 veterán picsu #3539

  Új Válasz 2008-05-16 14:17:56 #3540

  Ú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

  

  Delila_1

  veterán

  válasz picsu #3539 üzenetére

  Háát, ez több volt 1 percnél, oda a nyakad!

  Sub Válogatás()
  Sheets("Munka2").Select
  sor_2 = Range("A65536").End(xlUp).Row
  Sheets("Munka1").Select
  sor_1 = Range("A65536").End(xlUp).Row
  sor_3 = 1: f = 0
  For mu1 = 1 To sor_1
  sz = Cells(mu1, 1)
  For mu2 = 1 To sor_2
  If Sheets("Munka2").Cells(mu2, 1) = sz Then f = 1
  Next
  If f = 0 Then
  Sheets("Munka3").Cells(sor_3, 1) = sz
  sor_3 = sor_3 + 1
  
  End If
  f = 0
  Next
  Sheets("Munka2").Select
  For mu2 = 1 To sor_2
  sz = Cells(mu2, 1)
  For mu1 = 1 To sor_1
  If Sheets("Munka1").Cells(mu1, 1) = sz Then f = 1
  Next
  If f = 0 Then
  Sheets("Munka3").Cells(sor_3, 1) = sz
  sor_3 = sor_3 + 1
  End If
  f = 0
  Next
  End Sub

• #3202 Delila_1 veterán picsu #3201

  Új Válasz 2008-02-21 13:26:54 #3202

  Ú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

  

  Delila_1

  veterán

  válasz picsu #3201 üzenetére

  Ez egy kicsit komolyabb feladat annál, hogy hirtelen itt kapj választ.
  Ha van időd, előbb-utóbb megcsinálom.

• #2879 Delila_1 veterán picsu #2878

  Új Válasz 2007-12-17 16:05:49 #2879

  Ú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

  

  Delila_1

  veterán

  válasz picsu #2878 üzenetére

  Szívesen, örülök, hogy sikerült megkíméljelek egy csomó munkától. Én meg tanulok belőle.

• #2871 Delila_1 veterán picsu #2870

  Új Válasz 2007-12-17 12:51:19 #2871

  Ú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

  

  Delila_1

  veterán

  válasz picsu #2870 üzenetére

  Mondták, igaz, akkor istennőt mondtak. Köszönöm. Itt a javított kiadás hibakezeléssel.

  Sub Adatok()
  utvonal = "E:\Eadat\"
  sor = 2
  Do While Cells(sor, 1) <> ""
  fnev = Cells(sor, 1) & ".xls"
  funev = utvonal & Cells(sor, 1)
  On Error GoTo hiba
  Workbooks.Open Filename:=funev
  If tal = 0 Then
  ActiveWindow.ActivatePrevious
  Cells(sor, 2).Select
  ActiveCell.Formula = "=INDIRECT(""[" & fnev & "]Munka1!B3"")"
  Cells(sor, 3).Select
  ActiveCell.Formula = "=INDIRECT(""[" & fnev & "]Munka1!C6"")"
  Cells(sor, 4).Select
  ActiveCell.Formula = "=SUM(INDIRECT(""[" & fnev & "]Munka1!E1:E7""))"
  Range(Cells(sor, 2), Cells(sor, 4)).Select
  Selection.Copy
  Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
  False, Transpose:=False
  Application.CutCopyMode = False
  ActiveWindow.ActivateNext
  ActiveWindow.Close
  Else
  Cells(sor, 2) = "Nem létező file"
  End If
  tal = 0
  sor = sor + 1
  Loop
  Exit Sub
  
  hiba:
  Err = 0
  tal = 1
  Resume Next
  
  End Sub

• #2868 Delila_1 veterán picsu #2866

  Új Válasz 2007-12-16 16:15:34 #2868

  Ú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

  

  Delila_1

  veterán

  válasz picsu #2866 üzenetére

  Szia!
  Ezt a makrót vidd be a teszt.xls-edbe:

  Sub Adatok()
  utvonal = "E:\Eadat\"
  sor = 2
  Do While Cells(sor, 1) <> ""
  fnev = Cells(sor, 1) & ".xls"
  funev = utvonal & Cells(sor, 1)
  Workbooks.Open Filename:=funev
  ActiveWindow.ActivatePrevious
  Cells(sor, 2).Select
  ActiveCell.Formula = "=INDIRECT(""[" & fnev & "]Munka1!B3"")"
  Cells(sor, 3).Select
  ActiveCell.Formula = "=INDIRECT(""[" & fnev & "]Munka1!C6"")"
  Cells(sor, 4).Select
  ActiveCell.Formula = "=SUM(INDIRECT(""[" & fnev & "]Munka1!E1:E7""))"
  Range(Cells(sor, 2), Cells(sor, 4)).Select
  Selection.Copy
  Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
  False, Transpose:=False
  Application.CutCopyMode = False
  ActiveWindow.ActivateNext
  ActiveWindow.Close
  sor = sor + 1
  Loop
  End Sub

  A 2. sorban az útvonalat írd át a saját útvonaladra, és ha a füzeteknek nem a Munka1 lapjáról kell beolvasni az adatokat, írd át mind a 3 helyen azt is az ActiveCell.Formula kezdetű sorokban. Jó munkát.

• #2190 koob senior tag picsu #2172

  Új Válasz 2007-04-25 20:27:26 #2190

  Ú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

  

  koob

  senior tag

  válasz picsu #2172 üzenetére

  logikus megoldás :S

• #2155 loszerafin senior tag picsu #2147

  Új Válasz 2007-04-12 21:21:08 #2155

  Ú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

  

  loszerafin

  senior tag

  válasz picsu #2147 üzenetére

  Ennek a kérdésnek nincs köze az excelhez.
  
  1. letölteni a html-eket
  2. kinyerni belőle a nickneveket, egyesével egymás alá.
  3. betölteni excelbe csv-ként

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