Prosím o pomoc asi z MAKROM

[lexlutor]

Dobrý
Mám taký veľký problme potrebujem z modifiovať údaje v Excel tabulke... podľa vzoru upraveneho v prílohe a vraj to ide s makrom ale ja s tym neviem ani pohnuť....
OČO IDE??? V stlpci C mám ID a potrebujem aby mi ak je rovnake ID do prislušneho riadku v stlpci I vložila s modifikovaný textový retazec ktorý pozostáva z nápis Veľkosť :" posledne 2 čísla z prislušných riadkov zo stlpca B" kde je je rovnake ID tzn rovanká číslovka so stpca C.
AK mam v troch bunkach rovnake ID tak to bude vyzerať že Veľkosť : 7 Veľkosť : 8 Veľkosť 9 pričom tie čísla dostanem ako posledné 2 čísla so stlpca B

DAKUJEM moc by ste mi pomohli...

[Reklama]

[navstevnik]

Nize je uvedena procedura vykonavajici pozadovanou cinnost. V editoru VBA (Alt+F11) vloz do standardniho modulu (uprav v radku Set SBlk=... nazev listu a oblast ve sloupci C2:Cxx, v radku If FCll.value = ... uprav slovo velikost, editor poradny nebere slovenskou diakritiku), zaznamy nemusi byt setrideny:

Kód: Vybrat vše

Option Explicit

Sub Sestav()
  Dim SBlk As Range, SCll As Range
  Dim FBlk As Range, FCll As Range
  Set SBlk = Worksheets("Hárok1").Range("c2:c10")  ' nazev listu a adresa bloku ve sloupci C:C
  Set FBlk = SBlk
  For Each SCll In SBlk.Cells
    For Each FCll In FBlk.Cells
      If FCll.Value = SCll.Value Then SCll.Offset(0, 6).Value = SCll.Offset(0, 6).Value & "velikost: " _
          & Val(Right(FCll.Offset(0, -1).Value, 2)) & ","
    Next FCll
  Next SCll
  Set SBlk = Nothing
  Set SCll = Nothing
  Set FBlk = Nothing
  Set FCll = Nothing
End Sub

Doplneno:
pokud nasledujici proceduru spustis (z nabidky Nastroje>Makro>... nebo klavesovou zkratkou) na aktivnim listu (list s daty), nacte sama prislusny blok bunek ve sloupci C2:Cxx a doplni udaje:

Kód: Vybrat vše

Option Explicit

Sub Sestav()
  Dim SBlk As Range, SCll As Range
  Dim FBlk As Range, FCll As Range

  With ActiveSheet
    Set SBlk = .Range("c2:c" & .Cells(Rows.Count, 3).End(xlUp).Row)
  End With
  Set FBlk = SBlk
  For Each SCll In SBlk.Cells
    SCll.Offset(0, 6).Font.Bold = True
    For Each FCll In FBlk.Cells
      If FCll.Value = SCll.Value Then SCll.Offset(0, 6).Value = SCll.Offset(0, 6).Value & "velikost: " _
          & Val(Right(FCll.Offset(0, -1).Value, 2)) & ","
    Next FCll
  Next SCll
  Set SBlk = Nothing
  Set SCll = Nothing
  Set FBlk = Nothing
  Set FCll = Nothing
End Sub