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

• #23721 slashing senior tag slashing #23720

  Új Válasz 2014-10-14 23:15:52 #23721

  Ú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

  

  slashing

  senior tag

  válasz slashing #23720 üzenetére

  Amúgy én úgy képzelem/képzeltem el hogy először megkerestetem a célfájl azon sorát amiben a legtovább van adat ezt eltározom egy változóban sorazonosítóként aztán van egy ciklusom ami végigfut az első tábla fejlécsorán mégpedig úgy hogy csinál egy keresést a másik fájl fejlécében és ahol megtalálja az egyezőt ott eltározom az oszlop azonosítót ha ez meg van akkor van egy sor és oszlopazonosítom ahova bemásolhatja az adatokat. Arra mondjuk figyelni kell hogy a sorazonosító ne legyen ciklusban nehogy lépcsős legyen az egész. Így leírva milyen egyszerű

• #23722 Fferi50 őstag slashing #23720

  Új Válasz 2014-10-14 23:43:08 #23722

  Ú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

  

  Fferi50

  őstag

  válasz slashing #23720 üzenetére

  Szia!

  Most ellenőriztem, sajnos a speciális szűrés nem megy, mert ha nincs olyan fejléc a szűrendő mezőben, akkor hibát dob (bár nem egészen értem a logikáját, hogy miért, de ez van, ezt kell elfogadni.)

  Másik ötlet:
  Képlet szinten: Hol.van függvénnyel meghatároznám, hogy az adott fejléc hanyadik oszlopban van a másik táblában és abba az oszlopba kell tenni az adatot. (Nyilván ezt le lehet makróval rendezni (match függvény)).
  Tehát: kb.így nézne ki
  set mlap1=workbooks("Munkafüzet3").sheets("Munka1")
  set mlap2=workbooks("Munkafüzet4").sheets("Munka1")
  itt kezdheted az oszlopok ciklusát
  oszlop=application.match(mlap1.range("A1").value;mlap2.rows('"1:1"),0)
  if not iserror(oszlop) then ' ez csak azért kell, ha mégsem lenne olyan fejléc a másik munkalapon
  yy=mlap.cells(40000,oszlop).end(xlup).row+1
  for xx=2 to mlap1.range("A2").end(xldown).row
  mlap2.cells(yy,oszlop).value=mlap1.cells(yy,"A").value
  yy=yy+1
  next
  else
  msgbox "Nincs ilyen fejléc: " & mlap1.range("A1").value
  endif
  next oszlopok

  A makró csak szemléltető, nem feltétlenül hibátlan.
  Ezt végigcsinálod minden oszlopon, és minden kis táblán.
  Ha deklarálod a változókat, az oszlop mindenképpen variant legyen, mert annak értéke hiba is lehet, mint látod.

  Remélem érthető és tudod használni.

  Üdv.

• #23723 Delila_1 Topikgazda slashing #23720

  Új Válasz 2014-10-15 09:32:49 #23723

  Ú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

  Topikgazda

  válasz slashing #23720 üzenetére

  Nem teljesen olyan, mint a képen, de hasonlít. Ha kevesebb dolgom lesz, megpróbálom azt a formát kihozni.

  Sub Oszlopok()
  Dim WS1 As Worksheet, WS2 As Worksheet, sor As Long, usor As Long
  Dim oszlop As Integer, uoszlop As Integer, cim As String, oszlophova As Integer
  Dim WF As WorksheetFunction, sorhova As Long
  
  Set WS1 = Sheets("Munka1")
  Set WS2 = Sheets("Munka2")
  Set WF = Application.WorksheetFunction
  sor = 1
  
  WS1.Select
  
  Do While Cells(sor, 1) <> ""
  uoszlop = WS1.Range("A" & sor).End(xlToRight).Column
  For oszlop = 1 To uoszlop
  cim = Cells(sor, oszlop)
  On Error GoTo Tovabb
  oszlophova = WF.Match(cim, WS2.Rows(1), 0)
  Cells(sor + 1, oszlop).Select
  usor = Selection.End(xlDown).Row
  sorhova = WS2.Cells(Rows.Count, oszlophova).End(xlUp).Row + 1
  Range(Cells(sor + 1, oszlop), Cells(usor, oszlop)).Copy WS2.Cells(sorhova, oszlophova)
  
  Tovabb:
  On Error GoTo 0
  Next
  sor = Range("A" & sor).End(xlDown).Row
  sor = Range("A" & sor).End(xlDown).Row
  Loop
  End Sub

  Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.

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