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

• #42880 Fferi50 őstag Sesy #42877

  Új Válasz 2020-01-28 08:12:19 #42880

  Ú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 Sesy #42877 üzenetére

  Szia!
  A "kulcsok" megfeleltetését egy táblázatba érdemes foglalni. Szerintem érdemes a formázást egy munkalapon manuálisan megcsinálni, utána pedig ezt lehet másolni.
  Nálam a kódtábla ugyanazon a lapon van, ahol az adatok, és az alábbi makrót erről az aktív munkalapról kell indítani:
  Sub osztas()
Dim sh As Worksheet, wb As Workbook, cl As Range, tabla As Range, klcs As String, mlapnev As String, sh1 As Worksheet
Set sh = ActiveSheet
Set tabla = Range("X1:Y100") 'itt van a kulcstábla
On Error Resume Next
For Each cl In sh.UsedRange.Columns(1).Offset(1, 0).Cells 'az első oszlopon a 2. cellától megy végig
    If cl.Value = "" Then Exit For 'üres cella esetén kilép a ciklusból
    klcs = Left(cl.Value, 2) ' az első két karakter a kulcs
    mlapnev = tabla.Find(what:=klcs, LookIn:=xlValues, lookat:=xlWhole).Offset(0, 1).Value
    If Err = 0 Then ' ha megtaláltuk az értéket a kulcstáblában, akkor
        Set sh1 = Sheets(mlapnev)
        If Err = 9 Then ' ha még nincs ilyen nevű munkalap
            Sheets("Sablon").Copy after:=Sheets(Sheets.Count) ' a Sablon nevű munkalapot másoljuk
            Set sh1 = Sheets(Sheets.Count) ' és átnevezzük
            sh1.Name = mlapnev
            Err = 0
        End If
        sh1.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Value = cl.Value 'a B oszlop első üres cellájába másoljuk a cella értékét
     Else ' figyelmeztetés, hogy olyan kulcs van, amihez még nincs érték        MsgBox "Ehhez a kulcshoz nincs név: " & klcs, vbInformation
        Err = 0 ' ezt az értéket figyelmen kívül hagyja és megy tovább
     End If
Next
On Error GoTo 0
sh.Activate
MsgBox "kész vagyok", vbExclamation
End Sub
  A már meglevő munkalapokon az adatok nem íródnak felül, tehát ismételt feldolgozás esetén duplázódnak.
  Ha kérdésed van, írj bátran.
  Üdv.

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