elninoslov napsal/a:
Iba ak to bude prkotina. Nasľuboval som už kadekomu hory-doly, a nemám kedy (často ani chuť) skoro nič urobiť ...
Pošli to na mail.
Super Funguje. Můžu Tě poprosit ještě o jednu věc prosím? Asi bude lepší přes email... Díky
Zdravím, měl bych dotaz. Mám zde nástroj na tvoření formulárů, které se mě po zmáčknutí tlačítka uloží do složky jako jednotlivé soubory. 3lo by přidělat, že se prvně z cílové složce vytvoří složka s aktuálním datem (například 3.10.2019) a teprve do té se uloží všechny soubory z tabulky?
zde je makro co zatím mám
Sub Create_RunRate_Forms()
Dim lngRows As Long, arrData(), i As Long, tmpWB As Workbook, strPath As String, IsOpened As Boolean, intFormat As Integer, arrPart(1 To 2, 1 To 1), bSkipReplace As Byte, strFile As String, bSave As Boolean
strPath = ThisWorkbook.Path & Application.PathSeparator
With wsSource
lngRows = .Cells(Rows.Count, 1).End(xlUp).Row - 1
If lngRows = 1 Then MsgBox "There are no data", vbCritical, "No data": Exit Sub
arrData = .Cells(2, 1).Resize(lngRows, 7).Value2
End With
Application.ScreenUpdating = False
On Error Resume Next
Set tmpWB = Workbooks("runrate-template.xls")
If tmpWB Is Nothing Then
Set tmpWB = Workbooks.Open(strPath & "runrate-template.xls")
If tmpWB Is Nothing Then MsgBox "File is missing : runrate-template.xls", vbCritical, "Missing template": GoTo ENDPROC
Else
IsOpened = True
End If
i = Len(tmpWB.Worksheets("Run at Rate").Name)
If i = 0 Then MsgBox "List is missing : Run at Rate", vbCritical, "Missing list": GoTo WBCLOSE
strPath = strPath & "RunRate Forms" & Application.PathSeparator
If Len(Dir(strPath, vbDirectory)) = 0 Then MsgBox "Path for forms is missing : " & vbNewLine & strPath, vbCritical, "Missing path": GoTo WBCLOSE
On Error GoTo 0
intFormat = IIf(Val(Application.Version) < 12, -4143, 56)
Application.DisplayAlerts = False
With tmpWB.Worksheets("Run at Rate")
For i = 1 To lngRows
strFile = strPath & arrData(i, 1) & "_" & arrData(i, 2) & ".xls"
If bSkipReplace = 0 Then
If Len(Dir(strFile)) <> 0 Then
Select Case MsgBox("Files exist :" & vbNewLine & strFile & vbNewLine & vbNewLine & "YES - Replace all" & vbNewLine & "NO - Skip all" & vbNewLine & "CANCEL - Exit procedure", vbCritical + vbYesNoCancel, "Any files exists")
Case vbYes: bSkipReplace = 1
Case vbNo: bSkipReplace = 2
Case vbCancel: Exit For
End Select
End If
End If
If bSkipReplace < 2 Then bSave = True Else bSave = Len(Dir(strFile)) = 0
If bSave Then
arrPart(1, 1) = arrData(i, 1): arrPart(2, 1) = arrData(i, 2)
.Cells(4, 4).Resize(2).Value2 = arrPart
.Cells(6, 5).Value2 = arrData(i, 7)
Erase arrPart
If Not IsEmpty(arrData(i, 3)) Then arrPart(1, 1) = arrData(i, 3)
If Not IsEmpty(arrData(i, 4)) Then arrPart(2, 1) = arrData(i, 4)
.Cells(5, 8).Resize(2).Value2 = arrPart
tmpWB.SaveAs strFile, intFormat
'DoEvents
'Application.StatusBar = "Files " & i & " / " & lngRows & " completed"
'DoEvents
End If
Next i
End With
Application.DisplayAlerts = True
'Application.StatusBar = False
WBCLOSE:
If Not IsOpened Then tmpWB.Close False
Set tmpWB = Nothing
ENDPROC:
Application.ScreenUpdating = True
End Sub
JoKe napsal/a:
=KDYŽ(COUNTIF(F6:J6;"YES")=0;"C";KDYŽ(NEBO(F6="YES";H6="YES");"A";"B"))
Ahoj chtěl bych Vás požádat o pomoc. Mám mimo jiné hodnocení dodávaných dílů, je ohodnotit podle kriticity.
Kritéria jsou nový dodavatel, unikátní forma, unikátní technologie a dodavatel pod měsícním dohledem.
v přiloženém souboru se tedy každý díl hodnotí 5-ti hodnoceními ANO nebo NE (sloupec F až J). Po vyplnění bych potom potřeboval doplnit do sloupce K rozhodnutí dle následujících pravidel.
Když vše ze sloupců F až J bude NO - sloupec K bude písmeno C
Když New Supplier (sloupec F)bude YES - sloupec K bude písmeno A
Když Unique tooling (sloupec H) bude YES - sloupec K bude písmeno A
A když New/unique technology nebo Supplier under monitoring bude YES, tak sloupec K bude B
S tím, že poslední je pravidlo, že pokud by by jakýkolic sloupec F nebo H měl YES, automaticky to A, nehledě na to, co říkají ostatní sloupce.
Pokud cokoliv ostatní bude YES krom (F nebo H) tak automaticky to bude B a pokud vše bude NO, pak automaticky to bude C
Snad jsem to vysvětlil srozumitelně.
Děkuji V8m
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
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.