Question

我有一张表格，其中所有日期都在错误的时区。我需要为所有格式化为日期的单元格添加一小时，但保留其余单元格。

我发现了这个：

import axios from 'axios';

const fetchClient = () => {
  const defaultOptions = {
    baseURL: process.env.REACT_APP_API_PATH,
    method: 'get',
    headers: {
      'Content-Type': 'application/json',
    },
  };

  // Create instance
  let instance = axios.create(defaultOptions);

  // Set the AUTH token for any request
  instance.interceptors.request.use(function (config) {
    const token = localStorage.getItem('token');
    config.headers.Authorization =  token ? `Bearer ${token}` : '';
    return config;
  });

  return instance;
};

export default fetchClient();

现在，我如何找到包含日期的单元格？

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 ...

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

无论您处理的数据量多少，这都应该是安静的。不言而喻，如果没有看过你的工作簿并且必须经过全面测试，这可能无法解决所有问题。

在Excel工作表中搜索日期并添加一小时

2 个答案: