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

• #9556 Delila_1 veterán Charlie Gordon #9554

  Új Válasz 2011-02-25 09:21:11 #9556

  Ú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 Charlie Gordon #9554 üzenetére

  Más felfogásban, általánosítva a sorok és oszlopok számát:

  Sub Adatosszesites()
  Dim w2 As Worksheet
  Dim sor As Integer, sor_1 As Integer
  Dim oszlop As Integer, oszlop_1 As Integer
  Dim datumok As Integer, nevek As Integer
  
  
  Set w2 = Worksheets(2)
  Sheets(1).Select
  
  datumok = ActiveSheet.UsedRange.Columns.Count
  sor_1 = 1: oszlop_1 = 2
  nevek = Range("A2").End(xlDown).Row
  
  For sor = 2 To nevek
  w2.Cells(sor_1, 1) = Cells(sor, 1)
  
  For oszlop = 2 To datumok Step 2
  w2.Cells(sor_1, oszlop_1) = Cells(1, oszlop)
  w2.Cells(sor_1, oszlop_1 + 1) = Cells(sor, oszlop)
  w2.Cells(sor_1, oszlop_1 + 2) = Cells(sor, oszlop + 1)
  oszlop_1 = oszlop_1 + 3
  Next oszlop
  sor_1 = sor_1 + 1
  oszlop_1 = 2
  Next sor
  End Sub

• #9555 perfag aktív tag Charlie Gordon #9554

  Új Válasz 2011-02-24 21:41:19 #9555

  Ú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

  

  perfag

  aktív tag

  válasz Charlie Gordon #9554 üzenetére

  Próbálkozz ezzel:
  Sub cc()
  Dim w As Worksheet
  
  Set w = Worksheets(1)
  Sheets(1).Select
  
  datumok = 3 '1 sorban a dátumpárok száma
  sor = 0
  nevek = 3 'A oszlopban ennyi név van
  
  For j = 1 To nevek
  nev = w.Cells(j + 1, 1)
  
  For i = 1 To datumok
  datum = w.Cells(1, 1 + 2 * i - 1)
  mikor = w.Cells(j + 1, 1 + 2 * i - 1)
  mennyi = w.Cells(j + 1, 2 + 2 * i - 1)
  
  Sheets(2).Select
  sor = sor + 1
  Cells(sor, 1) = nev
  Cells(sor, 2) = datum
  Cells(sor, 3) = mikor
  Cells(sor, 4) = mennyi
  Next i
  Next j
  End Sub

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