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

• #32264 Lasersailing senior tag RedHarlow #32262

  Új Válasz 2016-08-08 09:32:14 #32264

  Ú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

  

  Lasersailing

  senior tag

  válasz RedHarlow #32262 üzenetére

  Szia,

  Ha jól értettem a feladatot, akkor az alábbi:
  Sub redharlow()

Dim sor As Integer
Dim oszlop As Integer
Dim ujsor As Integer
Dim sn As String


'program
sor = 1
sn = ActiveSheet.Name
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "eredmeny"
ujsor = 1
'fejlécet
Sheets("eredmeny").Cells(1, 1) = "Név"
Sheets("eredmeny").Cells(1, 2) = "C oszlop"
Sheets("eredmeny").Cells(1, 3) = "D oszlop"
Sheets("eredmeny").Cells(1, 4) = "E oszlop"
[B]Sheets("eredmeny").Cells(1, 5) = "Dátum"[/B]
Sheets("eredmeny").Cells(1, 6) = "Ft"


Do
sor = sor + 1
For oszlop = 7 To 66
If Not (IsEmpty(Sheets(sn).Cells(sor, oszlop))) Then
ujsor = ujsor + 1
Sheets("eredmeny").Cells(ujsor, 1) = Sheets(sn).Cells(sor, 2)
Sheets("eredmeny").Cells(ujsor, 2) = Sheets(sn).Cells(sor, 3)
Sheets("eredmeny").Cells(ujsor, 3) = Sheets(sn).Cells(sor, 4)
Sheets("eredmeny").Cells(ujsor, 4) = Sheets(sn).Cells(sor, 5)
[B] Sheets("eredmeny").Cells(ujsor, 5) = Sheets(sn).Cells(1, oszlop)[/B]
Sheets("eredmeny").Cells(ujsor, 6) = Sheets(sn).Cells(sor, oszlop)
End If
Next oszlop
Loop Until IsEmpty(Sheets(sn).Cells(sor, 1))


End Sub

  (kérlek jelezz vissza, hogy jól értettem-e és ha van kérdésed még)

  (Bocsánat találtam közben egy hibát, azt vastagon szedtem, hogy ki tud javítani)

  üdv.

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