Имя пользователя:
Пароль:
 

Показать сообщение отдельно

Динохромный


Contributor


Сообщения: 712
Благодарности: 322

Профиль | Отправить PM | Цитировать


Цитата Elizavetta:
но эта дата красным помечена, типа нет файла. и конечно же он не скопировался »
Это происходит из-за разного порядка представления дат в экселе и в названии файлов. Попробуйте код ниже, он временно переформатирует даты, затем вернет их первоначальное форматирование.
Код написан для диска С:.
код
Код: Выделить весь код
Public Sub RowsHide_FileCopy_rev3()
    Dim i As Long, j As Long, n As Long
    Dim myCell As Range
    Dim strFN As String
    Dim answ As Integer
    Dim diff As Double
    diff = 1 / 24 / 6
    n = ActiveSheet.Cells(2, 2).CurrentRegion.Rows.Count
    For i = 2 To n
        j = i + 1
        
        Do While j <= n And ActiveSheet.Cells(j, 2).Value - ActiveSheet.Cells(i, 2).Value <= diff
            ActiveSheet.Rows(j).Hidden = True
            j = j + 1
        Loop
        
        i = j - 1
        
    Next
    ActiveSheet.Rows(1).Hidden = True
    Intersect(ActiveSheet.Cells(2, 2).CurrentRegion, ActiveSheet.Columns(2)).Select
    Selection.NumberFormat = "yyyy/mm/dd h:mm:ss"
    Selection.SpecialCells(xlCellTypeVisible).Select
    For Each myCell In Selection
        
        If myCell.Value Like "##.##.#### #:##:##" Then
            strFN = Replace(Replace(Replace(myCell.Text, ".", "-"), " ", "_0") & ".dat", ":", ".")
            
        Else
            strFN = Replace(Replace(Replace(myCell.Text, ".", "-"), " ", "_") & ".dat", ":", ".")
            
        End If
        strFN = Dir("c:\metrology\pda???_" & strFN)
        
        If strFN <> "" Then
            
            FileCopy "c:\metrology\" & strFN, "c:\metrology1\" & strFN
            myCell.Interior.Color = vbGreen
        Else
            '            answ = MsgBox("Отсутствует файл d:\metrology\" & strFN & ", он будет пропущен. Продолжить обработку дальше?", vbYesNo, "Ошибка!")
            '            If answ = vbNo Then Exit Sub
            myCell.Interior.Color = vbRed
        End If
    Next
    ActiveSheet.Rows(1).Hidden = False
    Intersect(ActiveSheet.Cells(2, 2).CurrentRegion, ActiveSheet.Columns(2)).Select
    Selection.NumberFormat = "dd/mm/yyyy h:mm"
End Sub

Последний раз редактировалось a_axe, 01-02-2016 в 19:43.


Отправлено: 17:49, 01-02-2016 | #11