Musí to být makro?=ČÁST(C2;NAJÍT("-";C2)+1;5)-ZLEVA(C2;NAJÍT("-";C2)-1)Chybu jsem neřešilcitovat
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: rozdelenie bunky + rozdiel....VBA
ďakujem :) Ide o to, že tých stĺpcov na výpočet mam asi 50 a nie stále tento prepočet potrebujem. Myslel som, že v prípade potreby len kliknem a hodí mi tam vzorec a potiahne až dole :) nech to stále nemusím písať alebo kopírovať.citovat
MS Excel
Téma: rozdelenie bunky + rozdiel....VBA 
Zaslal/a Janko66 25.10.2018 12:43
Ahojte,
prosím o pomoc s makrom. Potreboval by som vytvoriť makro kde mi stlpec "A" s hodnotami "07:00-10:00" a pod. rozdelí a vypočíta rozdiel...následne hodnotu vloží do stĺpca "B1".
Ak náhodou rozdiel nevypočíta z dôvodu zápornej hodnoty, nech mi tam vloží napr. chyba.
To isté aj pre stĺpec "C"
Prikladám aj súbor. Vopred ďakujem.
Příloha: 
41746_pomoc.xlsx (10kB, staženo 29x)
41746_pomoc.xlsx (10kB, staženo 29x)eLCHa napsal/a:
Musí to být makro?=ČÁST(C2;NAJÍT("-";C2)+1;5)-ZLEVA(C2;NAJÍT("-";C2)-1)Chybu jsem neřešil
ďakujem :) Ide o to, že tých stĺpcov na výpočet mam asi 50 a nie stále tento prepočet potrebujem. Myslel som, že v prípade potreby len kliknem a hodí mi tam vzorec a potiahne až dole :) nech to stále nemusím písať alebo kopírovať.citovat
Príklad, aj s kontrolou či tam už nejaké dáta sú a pod. Spustíte to iba s ktorými stĺpcami chcete, vkladá rovno hodnoty, nie vzorce. AK by sa Vám nepozdávalo volať 50x procedúru pre každý stĺpec, môžeme to upraviť, aby urobilo všetko naraz.
Dim Otazka As Byte
Sub Vypocitaj()
Otazka = 0
Rozdel ActiveSheet.Columns(1)
Rozdel ActiveSheet.Columns(3)
End Sub
Sub Rozdel(STLP As Range)
Dim Riadkov As Long, Pole(), Kontrola As Long, i As Long, C
With STLP.Resize(Rows.Count - 1).Offset(1, 0)
Riadkov = STLP.Cells(Rows.Count, 1).End(xlUp).Row - 1
If Riadkov > 0 Then
Kontrola = WorksheetFunction.CountIf(.Offset(0, 1), "<>")
If Kontrola > 0 Then
Select Case Otazka
Case 0: Otazka = MsgBox("Vo výslednej oblasti sa už nachádzajú data." & vbNewLine & "Chcete ich prepísať ?", vbQuestion + vbYesNo, "Upozornenie")
If Otazka = 7 Then Exit Sub
Case 7: Exit Sub
End Select
End If
ReDim Pole(1 To Riadkov, 1 To 1)
If Riadkov = 1 Then Pole(1, 1) = .Value2 Else Pole = .Value2
On Error Resume Next
For i = 1 To Riadkov
If Pole(i, 1) <> "" Then
C = Split(Pole(i, 1), "-")
Pole(i, 1) = TimeValue(C(1)) - TimeValue(C(0))
Select Case Err.Number
Case Is > 0: Pole(i, 1) = CVErr(xlErrValue): Err.Clear
Case 0: If Pole(i, 1) < 0 Then Pole(i, 1) = CVErr(xlErrValue)
End Select
End If
Next i
On Error GoTo 0
.Offset(0, 1).Value2 = Pole
End If
End With
End Sub
Dim Otazka As Byte
Sub Vypocitaj()
Otazka = 0
Rozdel ActiveSheet.Columns(1)
Rozdel ActiveSheet.Columns(3)
End Sub
Sub Rozdel(STLP As Range)
Dim Riadkov As Long, Pole(), Kontrola As Long, i As Long, C
With STLP.Resize(Rows.Count - 1).Offset(1, 0)
Riadkov = STLP.Cells(Rows.Count, 1).End(xlUp).Row - 1
If Riadkov > 0 Then
Kontrola = WorksheetFunction.CountIf(.Offset(0, 1), "<>")
If Kontrola > 0 Then
Select Case Otazka
Case 0: Otazka = MsgBox("Vo výslednej oblasti sa už nachádzajú data." & vbNewLine & "Chcete ich prepísať ?", vbQuestion + vbYesNo, "Upozornenie")
If Otazka = 7 Then Exit Sub
Case 7: Exit Sub
End Select
End If
ReDim Pole(1 To Riadkov, 1 To 1)
If Riadkov = 1 Then Pole(1, 1) = .Value2 Else Pole = .Value2
On Error Resume Next
For i = 1 To Riadkov
If Pole(i, 1) <> "" Then
C = Split(Pole(i, 1), "-")
Pole(i, 1) = TimeValue(C(1)) - TimeValue(C(0))
Select Case Err.Number
Case Is > 0: Pole(i, 1) = CVErr(xlErrValue): Err.Clear
Case 0: If Pole(i, 1) < 0 Then Pole(i, 1) = CVErr(xlErrValue)
End Select
End If
Next i
On Error GoTo 0
.Offset(0, 1).Value2 = Pole
End If
End With
End Sub
Příloha: 
41755_rozdelenie-a-odpocet-casu.zip (19kB, staženo 29x)
citovat41755_rozdelenie-a-odpocet-casu.zip (19kB, staženo 29x)Uživatelské menu
Nejste přihlášen(a)
\n
\nMenu
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.
RSS nejnovější články