< návrat zpět
MS Excel
Téma: Úprava kopírujíécího makra 
Zaslal/a bloom 10.5.2014 10:47
Ahoj,
mám sestavené makro, které kopíruje řádek na jiný list, pokud se změní nějaká hodnota v buňce na onom řádku. Chtěl bych ho ale nastavit tak, aby nedošlo ke kopírování, když se hodnoty ve všech buňkách vymažou a řádek zůstane prázdný. Mohl bych poprosit o radu, co vložit do kódu? Mnohokrát děkuji. bloom
cmuch(10.5.2014 21:39)#019402 
Tady je makro, které si musíš trochu doupravit, páč nevím jaké makro máš.
Sub KopirujJenKdyzNecoJe()
Dim SrcRange As Range, CllSrcRange As Range
Dim ChngRow As Integer
Set SrcRange = Range("A" & ChngRow & ":K" & ChngRow)
'jsou vsechny bunky prazdne? pokud ano nedelej nic
For Each CllSrcRange In SrcRange.Cells
If IsEmpty(CllSrcRange) Then
'nedelej nic
Else
'sem napis to kopirovani
Exit For
End If
Next CllSrcRange
Set CllSrcRange = Nothing
End Subcitovatbloom(14.5.2014 7:35)#019457 Díky moc, zapracoval jsem to podle návodu nějak takhle
Dim ChngRow As Integer
Dim ChngCell As Boolean
Dim ChngCellValueOld As Variant
Dim ChngCellValueNew As Variant
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim SrcRange As Range
Dim NewRow As Integer
Dim CllSrcRange As Range
If ChngCell = True And Not ActiveCell.Row = ChngRow And Not ChngCellValueOld = ChngCellValueNew Then
Set SrcRange = Range("D" & ChngRow & ":S" & ChngRow)
For Each CllSrcRange In SrcRange.Cells
If IsEmpty(CllSrcRange) Then
Else
Range("S" & ChngRow).Value = Now
With Sheets("History")
.Range("a5").EntireRow.Insert
.Range("5:5").ClearFormats
.Range("A5:N5").Value = SrcRange.Value
.Range("O5").Value = Now
End With
Exit For
End If
Next CllSrcRange
Set CllSrcRange = Nothing
End If
ChngCell = False
ChngCellValueOld = ActiveCell.Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
ChngRow = Target.Row
ChngCell = True
ChngCellValueNew = Target.Value
End Sub
Ještě bych to rád upravil tak, aby se nekopírovalo v případě, když se celý řádek označí a hodnoty v něm se smažou (první otázka se týkala postupného vymyzávání). Moc děkuji za odpovědi. bloom
citovatcmuch(15.5.2014 8:20)#019487 Ještě bych to rád upravil tak, aby se nekopírovalo v případě, když se celý řádek označí a hodnoty v něm se smažou (první otázka se týkala postupného vymyzávání).
To je nějaká mýlka, přečti si svuj požadavek, upravil jsem tvoje makro.
Dim ChngRow As Integer
Dim ChngCell As Boolean
Dim ChngCellValueOld As Variant
Dim ChngCellValueNew As Variant
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim SrcRange As Range
Dim NewRow As Integer
Dim CllSrcRange As Range
If ChngCell = True And Not ActiveCell.Row = ChngRow And Not ChngCellValueOld = ChngCellValueNew Then
Set SrcRange = Range("D" & ChngRow & ":S" & ChngRow)
Application.EnableEvents = False
Range("S" & ChngRow).Value = Now
Application.EnableEvents = True
With Sheets("History")
.Range("a5").EntireRow.Insert
.Range("5:5").ClearFormats
.Range("A5:N5").Value = SrcRange.Value
.Range("O5").Value = Now
End With
Set CllSrcRange = Nothing
End If
ChngCell = False
ChngCellValueOld = ActiveCell.Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cll As Range
For Each Cll In Target.Cells
If IsEmpty(Cll) Then
Else
ChngRow = Target.Row
ChngCell = True
ChngCellValueNew = Target.Resize(1, 1).Value
Exit For
End If
Next
End Sub
citovat bloom(15.5.2014 21:21)#019496 Díky.
Mně ale omezení fungovalo, jen když se postupně ve všech buňkách (po přechodu z buňky do buňky) v řádku mažou hodnoty. Když ale označím lonkrétní vybranou oblast buněk v řádku a vymažu hodnoty najednou, hází mi to chybu, stejně tak jako v případě, když celý řádek odstraním. A tyhle situace bych ještě chtěl ošetřit. Díky moc za rady.
citovatcmuch(16.5.2014 6:27)#019498 Tak asi něco dělám špatně. Mě to nezlobí.
Posílám příklad.
Příloha: 
19498_priklad.zip (15kB, staženo 31x) citovat
RSS nejnovější články