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

• Delila_1 veterán

  #19726

  #19724 xao

  2013-12-02 10:05:23

  Ú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

  #19724 xao

  #19724 xao

  Üdv

  Az előbb lehet, hogy nem sikerült túlzottan érthetően leírnom, ezért megpróbálom még egyszer

  Adott egy lista cikkszámokkal, cikknevekkel, darabszámokkal, ami változó nyilvánvalóan napról napra.

  Ebből szeretnék egy másik táblában olyan listát csinálni, ami úgy néz ki, hogy cikkszám, cikknév. Viszont annyiszor legyen egymás alatt többször az adott dolog, ahányszor az első táblában lévő darabszám.

  Például:
  Egyik tábla (ezek az adatok vannak meg nekem, napról napra változhatnak)
  cikkszám, cikknév, db

  01 alma 2
  02 körte 3
  03 ribizli 5
  04 málna 1
  05 citrom 4

  A másik munkalapon pedig ez legyen belőle automatikusan:
  01 alma
  01 alma
  02 körte
  02 körte
  02 körte
  03 ribizli
  03 ribizli
  03 ribizli
  03 ribizli
  03 ribizli
  04 málna
  05 citrom
  05 citrom
  05 citrom
  05 citrom
  És így tovább...

  Szóval megoldható ez valahogy?
  Köszönöm

  A Set WS1 = Sheets("Munka1") sorban a Munka1 helyett írd be annak a lapodnak a nevét, ahol a darabszámok szerepelnek, a Munka2 helyére azt, ahova a többszörözést akarod beíratni.

  Sub Tobbszoroz()
  Dim sor As Long, usor As Long, ujsor As Long, eddig As Integer, a As Integer
  Dim WS1 As Worksheet, WS2 As Worksheet
  Set WS1 = Sheets("Munka1")
  Set WS2 = Sheets("Munka2")
  
  Application.ScreenUpdating = False
  
  WS2.Range("A:B").ClearContents 'Előző adatok törlése a Munka2 lapon
  WS1.Activate
  Range("A1:B1").Copy WS2.Range("A1") 'Címsor a Munka2 lapra
  usor = Range("A" & Rows.Count).End(xlUp).Row
  ujsor = 2
  For sor = 2 To usor
  eddig = Cells(sor, "C")
  For a = 1 To eddig
  Range("A" & sor & ":B" & sor).Copy WS2.Range("A" & ujsor)
  ujsor = ujsor + 1
  Next
  Next
  
  Application.ScreenUpdating = True
  End Sub

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