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

• Delila_1 veterán

  #10183

  #10180 Zomb€€

  2011-04-28 11:58:32

  Új Válasz

  Ú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

  

  Delila_1

  veterán

  #10180 Zomb€€

  Kértem, hogy tegyél be képet. Mivel nem tettél, a saját elképzelésem szerint írtam meg a makrót, majd átalakítod kedved (és az adataid) szerint.

  Az egyik lap neve Oktatás, ahol az A oszlop tartalmazza a szak kódját, a B oszlop a szakra jelentkező nevét.

  A másik lap Jelentkezők névre hallgat, ahol az A oszlopban van a név, a B:F oszlopokban a hozzájuk tartozó többi adat.

  A harmadik lap az Összesítés, itt az A oszlopban lesz a kód, B-ben a jelentkező neve, a C:G tartományban a jelentkező többi adata.

  Szerencsére azt tudom, hogy a 2007-es verziót használod. Nem mindegy, mert egészen más a rendezés a különböző verziókban.

  Sub Adategyesítés()
  Dim sorA%, usorA%, sorV%, usorV%, sorO%
  Dim kód$, név$, adatSor%
  Dim WSJ As Object, WSO As Object
  
  Sheets("Oktatás").Select
  usorA% = Range("A60000").End(xlUp).Row
  
  '"A" oszlop rendezése
  usorA% = Range("A60000").End(xlUp).Row
  ActiveWorkbook.Worksheets("Oktatás").Sort.SortFields.Clear
  ActiveWorkbook.Worksheets("Oktatás").Sort.SortFields.Add Key:=Range("A2"), _
  SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  With ActiveWorkbook.Worksheets("Oktatás").Sort
  .SetRange Range("A2:B" & usorA%)
  .Header = xlNo
  .MatchCase = False
  .Orientation = xlTopToBottom
  .SortMethod = xlPinYin
  .Apply
  End With
  
  'Egyedi rekordok szűrése a V oszlopba
  Range("A1:A" & usorA%).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
  "V1"), Unique:=True
  
  Set WSJ = Sheets("Jelentkezők")
  Set WSO = Sheets("Összesítés")
  usorV% = Range("V60000").End(xlUp).Row
  sorO% = 2
  
  For sorV% = 2 To usorV%
  kód$ = Cells(sorV%, 22)
  For sorA% = 2 To usorA%
  If Cells(sorA%, 1) = kód$ Then
  név$ = Cells(sorA%, 2)
  WSO.Cells(sorO%, 1) = kód$
  adatSor% = WSJ.Range("A:A").Find(név$).Row
  WSO.Cells(sorO%, 2) = WSJ.Cells(adatSor%, 1)
  WSO.Cells(sorO%, 3) = WSJ.Cells(adatSor%, 2)
  WSO.Cells(sorO%, 4) = WSJ.Cells(adatSor%, 3)
  WSO.Cells(sorO%, 5) = WSJ.Cells(adatSor%, 4)
  WSO.Cells(sorO%, 6) = WSJ.Cells(adatSor%, 5)
  WSO.Cells(sorO%, 7) = WSJ.Cells(adatSor%, 6)
  
  sorO% = sorO% + 1
  End If
  Next
  Next sorV%
  End Sub

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