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

• #27763 Fferi50 Topikgazda sedyke #27761

  Új Válasz 2015-07-14 21:33:56 #27763

  Ú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

  Topikgazda

  válasz sedyke #27761 üzenetére

  Szia!

  Úgy gondolom, megszületett a kielégítő megoldás:

  A makró:
  Sub termeklistas()
  Dim sh As Worksheet, ws As Worksheet, xx As Integer, yy As Integer
  Set ws = Sheets("Munka1")
  yy = 1
  For Each sh In Worksheets
  xx = 1
  If sh.Name <> ws.Name Then
  Do While True
  If sh.Cells(xx, "B").Value = "" Then Exit Do
  ws.Cells(yy, "N").Value = sh.Cells(xx, "B").Value
  ws.Cells(yy, "O").Value = sh.Name & "!"
  ws.Cells(yy, "P").Value = xx - 1
  xx = xx + 51
  yy = yy + 1
  Loop
  End If
  Next
  End Sub

  A makró az N oszlopba beírja a termékkódot, az O oszlopba a munkalap nevét, felkiáltójellel kiegészítve, a P oszlopba pedig az adott termék hol kezdődik a munkalapon -1.

  Hibaellenőrzés (mármint, hogy valóban termékkód van-e minden 51. cellában, nincs benne, azt a listából láthatod, ha átnézed).

  Ezek után a képletek:
  R1 cella (M)[/=FKERES($B$1;$N$1:$P$10;2;0)M]
  S1 cella (M)=FKERES($B$1;$N$1:$P$10;3;0)(/M)
  B3 cella (M)=INDIREKT($R$1 & "B" & $S$1+SOR())(/M)
  C3 cella (M)=INDIREKT($R$1 & "C" & $S$1+SOR())(/M)

  Az első sor tovább értelemszerűen változtatva csak a B,ill. C helyére írva az aktuális oszlopot.
  Ezután lefelé másolhatod a képleteket.

  A B1 cella érvényesítése: lista - forrás N1:P10

  Ezután a listából kiválasztod a termékkódot, a lap pedig automatikusan kitöltődik.

  A $P$10-ben a 10 helyett az utolsó "tele" cella sorszámát kell írni. (Minden másra ott a MasterCard )

  A makróra a lefuttatás után, amennyiben jónak találod az eredményt, nincs szükséged. Ha meg szeretnéd tartani, akkor makróbarátként kell elmenteni a munkafüzetet.

  Remélem, sikerülni fog.

  Üdv.

  [ Szerkesztve ]

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