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

• #16415 Delila_1 veterán Oly #16414

  Új Válasz 2013-01-21 18:59:17 #16415

  Ú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

  

  Delila_1

  veterán

  válasz Oly #16414 üzenetére

  Két külön makróba írtam az alsó, és a felső táblázat kitöltését, de veheted egybe.

  Sub Also()
  Dim sor%, oszlop%, sorB%
  sorB% = 15
  For sor% = 10 To 13
  For oszlop% = 2 To 4
  If Cells(sor%, oszlop%) > 0 Then
  Cells(sorB%, "A") = Date
  Cells(sorB%, "B") = Cells(sor%, "A")
  Cells(sorB%, "C") = Cells(9, oszlop%)
  Cells(sorB%, "D") = Cells(sor%, oszlop%)
  sorB% = sorB% + 1
  End If
  Next
  Next
  End Sub

  Sub Felso()
  Dim sor%, usor%, sorB%, oszlopB%, WF As WorksheetFunction
  Dim nev$, uzlet$
  Set WF = Application.WorksheetFunction
  usor% = Cells(Rows.Count, "A").End(xlUp).Row
  
  If Range("A15") >= Range("A1") And Range("A15") <= Range("C1") Then
  For sor% = 15 To usor%
  nev$ = Cells(sor%, "B")
  uzlet$ = Cells(sor%, "C")
  sorB% = WF.Match(nev$, Columns(1), 0)
  oszlopB% = WF.Match(uzlet$, Rows(3), 0)
  Cells(sorB%, oszlopB%) = Cells(sorB%, oszlopB%) + Cells(sor%, "D")
  Cells(sorB%, oszlopB% + 1) = Date
  Next
  End If
  End Sub

  A képen szereplő cellák helyéhez igazítottam a makrót. Bár nem látszanak a sor- és oszlopazonosítók, úgy vettem, hogy a kezdő dátum az A1-es cellában van.

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