엑셀 워크 시트에서 날짜를 검색하고 1 시간 추가

Question

모든 날짜가 잘못된 시간대에있는 시트가 있습니다. 날짜로 구성된 모든 셀에 1 시간을 추가해야하지만 나머지는 그대로 두어야합니다.

Public Function AddHour(ByVal sTime As String) As String 
    Dim dt As Date 

    dt = CDate(sTime) 
    dt = DateAdd("h", 1, dt) 

    AddHour = Format(dt, "mm/dd/yy h:nnam/pm") 

End Function 

지금, 어떻게 그들에 날짜와 세포를 찾을 수 있습니까

:

나는이 발견?

Sub AddHour(ByVal ThisSheet As Worksheet) ...

Answer 1

다음은 아래에 코멘트에서 제공하는 추가 정보를 적용하기 위해 수정 된 코드입니다.

Option Explicit 

Public Sub AddHour() 
    ' 17 Dec 2017 

    Const FirstColumn As String = "A"   ' set as required 
    Const LastColumn As String = "AV"   ' set as required 

    Dim Ws As Worksheet 
    Dim Cf As Long, Cl As Long     ' first/last column 
    Dim Dt As Double 
    Dim Rl As Long        ' last used row (in column C) 
    Dim R As Long, C As Long 

    Set Ws = Worksheets("AddHour")    ' replace with your sheet's name 
    Application.ScreenUpdating = False 
    With Ws 
     Cf = Columns(FirstColumn).Column 
     Cl = Columns(LastColumn).Column 
     For C = Cf To Cl 
      Application.StatusBar = Cl - C + 1 & " columns remaining" 
      Rl = .Cells(.Rows.Count, C).End(xlUp).Row 
      For R = 1 To Rl      ' start looking in row 1 (amend if necessary) 
       With .Cells(R, C) 
        If IsDate(.Value) Then 
         Dt = .Value 
         ' add 1 hour if there is a Time value in the date 
         If Dt - Int(Dt) Then .Value = Dt + (1/24) 
        End If 
       End With 
      Next R 
      Stop 
     Next C 
    End With 

    With Application 
     .ScreenUpdating = True 
     .StatusBar = False 
    End With 
End Sub 

당신은 아직도 당신의 워크 시트 정말이 어떤 이름으로 코드에서 워크 시트 이름 "AddHour을"대체 날짜는 첫 번째와 마지막 열을 지정해야합니다. 코드가 찾기 시작하는 첫 번째 행을 변경할 수 있습니다.

코드는 귀하의 날짜가 "실제"날짜라고 가정합니다. 변경하려는 날짜가있는 셀을 선택하고 셀 형식을 일시적으로 "일반"으로 설정하여이를 테스트 할 수 있습니다. 날짜가 "true"일 경우 43086.5046489583과 같이 날짜 대신 숫자가 표시됩니다. 셀을 다시 포맷 할 때 셀의 표시가 변경되지 않으면 날짜가 "텍스트"이므로 다르게 처리해야합니다.

Answer 2

당신이 당신의 시트에있는 모든 날짜는 당신이 당신의 사용 범위의 모든 세포를 통해 루프과 같이 함수를 사용하여 조정을 할 수있는 수정해야 할 것을 절대적으로 확신하는 경우

Sub ChangeDate() 

    Dim rngDates As Range 
    Dim varCounter As Variant 
    Dim dt As Date 

    Application.ScreenUpdating = False 
    Application.DisplayAlerts = False 
    Application.Calculation = xlManual 

    Set rngDates = ThisWorkbook.Worksheets("Tabelle2").UsedRange 

    'Loop over all cells in range 
    For Each varCounter In rngDates 
     'If it's a date, change its value 
     If IsDate(varCounter.Value) Then 
      dt = CDate(varCounter.Value) 
      dt = DateAdd("h", 1, dt) 
      varCounter.Value = Format(dt, "mm/dd/yy h:nnam/pm") 
     End If 

    Next varCounter 

    Application.ScreenUpdating = True 
    Application.DisplayAlerts = True 
    Application.Calculation = xlAutomatic 
End Sub 

을에 따라 사용 된 범위의 세포 양은별로 좋지 않을 수 있습니다.

우리가 배열로 사용 범위를 읽고과 같이 메모리에 처리 할 수있는에 개선하려면

Sub ChangeDate() 

    Dim varValues As Variant 
    Dim lngColumns As Long, lngRows As Long 
    Dim dt As Date 

    Application.ScreenUpdating = False 
    Application.DisplayAlerts = False 
    Application.Calculation = xlManual 

    'Read entire range to array 
    varValues = ThisWorkbook.Worksheets("Tabelle2").UsedRange 

    'Loop over all "columns" 
    For lngColumns = 1 To UBound(varValues, 1) 
     'Loop over all "rows" in that "column" 
     For lngRows = 1 To UBound(varValues, 2) 
      If IsDate(varValues(lngColumns, lngRows)) Then 
       dt = CDate(varValues(lngColumns, lngRows)) 
       dt = DateAdd("h", 1, dt) 
       varValues(lngColumns, lngRows) = Format(dt, "mm/dd/yy h:nnam/pm") 
      End If 
     Next lngRows 
    Next lngColumns 

    'Overwrite usedRange with array 
    ThisWorkbook.Worksheets("Tabelle2").UsedRange = varValues 

    Application.ScreenUpdating = True 
    Application.DisplayAlerts = True 
    Application.Calculation = xlAutomatic 
End Sub 

이 관계없이 처리하고 데이터의 양의 확대됨에 조용히해야한다. 이것은 통합 문서를 보지 않고 모든 것을 설명하지 않을 수 있으며 철저한 테스트를 거쳐야 함은 물론입니다.