Excelワークシートの日付を検索して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」を交換し、あなたの日付があり、最初と最後の列を指定する必要があります。コードが探し始める最初の行を変更することができます。

コードでは、あなたの日付が「本当の」日付であることが前提です。これをテストするには、変更する日付のセルを選択し、そのセルのフォーマットを一時的に「一般」に設定します。日付が「真」の日付の場合、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 

これは関係なく、あなたが処理しているデータの量のパフォーマンス静かにする必要があります。 これは、ワークブックを見たことがなくてもすべてを説明していない可能性があり、徹底的にテストしなければならないことは言うまでもない。