我怎樣才能使這個 VBA 循環工作到最后

Question

我已經嘗試了無數方法來讓這個簡單的循環工作，但似乎它不起作用。 我只是不想在列中某些日期的末尾刪除重復的年份並將其替換為正確的年份，我首先在單個模塊中使用嵌套的 for 循環來執行此操作。 然后我更改了用於其相關模塊中的每張工作表的代碼......還嘗試用任何內容替換重復的年份，然后添加正確的年份，但它總是掛在中間。 這是一個如此簡單的事情，我不明白為什么它不起作用.?? 它是與格式化有關的錯誤嗎？ 代碼是否以某種方式沒有很好地編程，效率不高或太重？ 我不知道！

Sub change_dates()

Dim wb As Workbook
Dim o As Long
Dim k As Long
Dim y As Long

Set wb = ThisWorkbook

y = Year(Date)
o = 2
k = wb.Worksheets(11).Cells(2, 10).Value + 2

Do While o < k

            If Mid(wb.Worksheets(11).Cells(o, 1), 4, 2) = 12 Then
            y = y - 1
            End If
            wb.Worksheets(11).Cells(o, 1) = Left(wb.Worksheets(11).Cells(o, 1), 6) & CStr(y)
o = o + 1
Loop

End Sub

這正是我運行 vba 代碼后單元格值的變化方式：

...
14/03/2014
14/02/2014
14/01/2014
13/12/2013
13/11/2013
13/10/2013
13/09/2013
13/08/2013
13/07/2013
13/06/2013
13/05/2013
13/04/2013
13/03/2013
13/02/2013
13/01/2013
    12-12-2012
    11-12-2012
    10-12-2012
    09-12-2012
    08-12-2012
    07-12-2012
    06-12-2012
    05-12-2012
    04-12-2012
    03-12-2012
    02-12-2012
    01-12-2012
    12-11-2011
    11-11-2011
    ...

如您所見，第一部分是我想要的，而使用相同的運行代碼，第二部分不是我想要的。 月份在變化，格式也在變化，下面是列的原始值，我只是簡單地改變重復年份！

...
22-01-2022
21-12-2022
21-11-2022
21-10-2022
21-09-2022
21-08-2022
21-07-2022
21-06-2022
21-05-2022
21-04-2022
21-03-2022
21-02-2022
21-01-2022
20-12-2022
20-11-2022
20-10-2022
20-09-2022
20-08-2022
20-07-2022
20-06-2022
...

這是期望的結果：

22-01-2022
21-12-2021
21-11-2021
21-10-2021
21-09-2021
21-08-2021
21-07-2021
21-06-2021
21-05-2021
21-04-2021
21-03-2021
21-02-2021
21-01-2021
20-12-2020
20-11-2020
20-10-2020
20-09-2020
20-08-2020
20-07-2020
...

進一步說明：

• 我得到日期是 =A2+1 的結果。
• A 列單元格的格式都像這樣 dd-mm-aaaa
• k 正在返回正確的數字。
• 結果應該看起來所有的日子和月份都保持不變，並且重復的 2022 年更改為從 2022 年開始的一年，每次到 12 月時從上到下減少一個。

Answer 1

問題是如果你使用像Mid()或Left()這樣的文本/字符串函數，你會從一個真正的數字日期（你可以實際計算）更改為一個看起來像日期但只是文本的文本（你不能用那個了）。 而 Excel 不知道這是一個日期。

因此，每當處理日期時，請使用Day() 、 Month()和Year()等數字日期函數將日期拆分為多個部分，並使用DateSerial(y, m, d)將新日期放在一起。 這將創建一個您可以計算的真實數字日期，並且您可以使用.NumberFormat進行格式化。

我將您的Do循環更改為For循環，該循環在Next o上自動增加o ，這看起來更干凈一些。

Public Sub change_dates()
    Dim ws As Worksheet  ' define your worksheet only once
    Set ws = ThisWorkbook.Worksheets(11) ' if it ever changes from 11 to 12 it only needs to be changed here
    
    Dim y As Long
    y = Year(Date)
    
    Dim k As Long
    k = ws.Cells(2, 10).Value + 1
    
    Dim o As Long
    For o = 2 To k  ' loop from 2 to k
        Dim m As Long  ' get month of current cell
        m = Month(ws.Cells(o, 1))
        
        Dim d As Long  ' get day of current cell
        d = Day(ws.Cells(o, 1))
        
        If m = 12 Then  ' check if year needs to change
            y = y - 1
        End If
        
        ws.Cells(o, 1) = DateSerial(y, m, d)  ' create a real numeric date and write it to the cell
        
        ' if the date needs to show in another format just change the numberformat to whatever you need
        'ws.Cells(o, 1).NumberFormat = "dd-mm-yyyy"
    Next o
End Sub

Answer 2

操作列中的日期

Option Explicit

Sub change_dates()
    
    Const wsID As Variant = 11 ' e.g. "Sheet11" is a little more reliable
    Const fRow As Long = 2
    Const Col As String = "A"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Reference the column range ('rg').
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsID)
    Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, Col).End(xlUp).Row
    If lRow < fRow Then Exit Sub ' no data
    Dim rg As Range: Set rg = ws.Range(ws.Cells(fRow, Col), ws.Cells(lRow, Col))
    
    Dim cCell As Range
    Dim cValue As Variant
    Dim y As Long, m As Long, d As Long
    Dim FirstDone As Boolean
    
    ' Read and write.
    For Each cCell In rg.Cells
        cValue = cCell.Value
        If IsDate(cValue) Then
            If FirstDone Then
                d = Day(cValue)
                m = m - 1
                If m = 0 Then
                    m = 12
                    y = y - 1
                End If
                cCell.Value = DateSerial(y, m, d)
            Else ' first date stays as is
                y = Year(cValue)
                m = Month(cValue)
                FirstDone = True
            End If
        End If
        
    Next cCell
    
End Sub