Zdravím,
je tu spousty rad a něco mi pomůže, ale jsem naprostý amatér a řeším jeden problém.
Potřebuji aby mi tento script dokázal nejen zapsat ty hodnoty, ale přidat je pod poslední záznam. Teď pouze zapíše a přepíše.
Sub ZapisLidiDoDenniZaznam()
poc = 0
For i = 2 To 1000
If Cells(i, 11).Value <> "" Then
'cteni z
Měsíc = Cells(i, 1)
ID = Cells(i, 2)
Záloha = Cells(i, 5)
Datum = Cells(i, 6)
Způsob = Cells(i, 7)
Prémie = Cells(i, 8 )
Poznámka = Cells(i, 9)
'zapis do
Sheets("Denní záznam").Cells(2 + poc, 1) = Měsíc
Sheets("Denní záznam").Cells(2 + poc, 2) = ID
Sheets("Denní záznam").Cells(2 + poc, 7) = Záloha
Sheets("Denní záznam").Cells(2 + poc, 8 ) = Datum
Sheets("Denní záznam").Cells(2 + poc, 9) = Způsob
Sheets("Denní záznam").Cells(2 + poc, 10) = Prémie
Sheets("Denní záznam").Cells(2 + poc, 11) = Poznámka
poc = poc + 1
End If
Next
Sheets("Denní záznam").Select
End Sub
Předem moc díky za pomoc
Makro - přidání místo přepsání Vyřešeno
-
- nováček
- Příspěvky: 1
- Registrován: listopad 18
- Pohlaví:
- Stav:
Offline
- elninoslov
- Level 2.5
- Příspěvky: 375
- Registrován: červen 13
- Pohlaví:
- Stav:
Offline
Re: Makro - přidání místo přepsání Vyřešeno
No, bez prílohy, čisto z brucha ...
Smerodajný stĺpec pre určenie počtu vyplnených riadkov som dal v oboch listoch 11, teda K:K.
EDIT 26.11.2018 18:45 :
Malá oprava kódu, zabudol som transponovať pole DZ1. Opravená aj ukážka aj príloha. Namiesto
má byť samozrejme
Smerodajný stĺpec pre určenie počtu vyplnených riadkov som dal v oboch listoch 11, teda K:K.
Kód: Vybrat vše
Sub ZapisLidiDoDenniZaznam()
Dim Radku As Long, i As Long, Pocet As Long, D(), DZ1(), DZ2()
With ThisWorkbook
With .ActiveSheet
Radku = .Cells(Rows.Count, 11).End(xlUp).Row - 1
If Radku = 0 Then Exit Sub
ReDim D(1 To Radku, 1 To 11)
D = .Cells(2, 1).Resize(Radku, 11).Value
For i = 1 To Radku
If D(i, 11) <> "" Then
'cteni z
Pocet = Pocet + 1
ReDim Preserve DZ1(1 To 2, 1 To Pocet)
ReDim Preserve DZ2(1 To 5, 1 To Pocet)
DZ1(1, Pocet) = D(i, 1): DZ1(2, Pocet) = D(i, 2)
DZ2(1, Pocet) = D(i, 7): DZ2(2, Pocet) = D(i, 8): DZ2(3, Pocet) = D(i, 9)
DZ2(4, Pocet) = D(i, 10): DZ2(5, Pocet) = D(i, 11)
End If
Next i
End With
If Pocet > 0 Then
'zapis do
With .Worksheets("Denní záznam")
Radku = .Cells(Rows.Count, 11).End(xlUp).Row + 1
.Cells(Radku, 1).Resize(Pocet, 2).Value = WorksheetFunction.Transpose(DZ1)
.Cells(Radku, 7).Resize(Pocet, 5).Value = WorksheetFunction.Transpose(DZ2)
.Activate
End With
End If
End With
End Sub
EDIT 26.11.2018 18:45 :
Malá oprava kódu, zabudol som transponovať pole DZ1. Opravená aj ukážka aj príloha. Namiesto
Kód: Vybrat vše
.Cells(Radku, 1).Resize(Pocet, 2).Value = DZ1
má byť samozrejme
Kód: Vybrat vše
.Cells(Radku, 1).Resize(Pocet, 2).Value = WorksheetFunction.Transpose(DZ1)
- Přílohy
-
- Zápis lidí do Denní záznam.xlsm
- (21.39 KiB) Staženo 21 x
-
- Mohlo by vás zajímat
- Odpovědi
- Zobrazení
- Poslední příspěvek
-
- 6
- 1300
-
od Zivan
Zobrazit poslední příspěvek
17 led 2024 08:57
-
- 2
- 1225
-
od petr22
Zobrazit poslední příspěvek
21 úno 2024 19:10
-
- 0
- 2886
-
od Karrex
Zobrazit poslední příspěvek
03 kvě 2024 13:30
-
- 7
- 2158
-
od richchie
Zobrazit poslední příspěvek
24 říj 2023 09:25
-
-
Něco mi žere misto na szstemovem SSD Příloha(y)
od Ketty02 » 13 zář 2024 12:36 » v Vše ostatní (bezp) - 14
- 1592
-
od buchtik
Zobrazit poslední příspěvek
14 zář 2024 10:56
-
Kdo je online
Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 0 hostů