简体   繁体   English

我怎样才能使这个 VBA 循环工作到最后

[英]How can I make this VBA loop work until the end

I have tried countless ways to put this simple loop to work, but it seems like it just won't work.我已经尝试了无数方法来让这个简单的循环工作,但似乎它不起作用。 I just wan't to remove a repeating year at the end of some dates in a column and replace those by the right year, I started by doing this with a nested for loop in a single module.我只是不想在列中某些日期的末尾删除重复的年份并将其替换为正确的年份,我首先在单个模块中使用嵌套的 for 循环来执行此操作。 then I changed the code to be used for each sheet in it's relative module... Also tried replacing the repeating year with nothing and then adding the right year but it always hangs at the middle.然后我更改了用于其相关模块中的每张工作表的代码......还尝试用任何内容替换重复的年份,然后添加正确的年份,但它总是挂在中间。 This is such a simple thing and I don't understand why it is not working.??这是一个如此简单的事情,我不明白为什么它不起作用.?? Is it a bug related to the formating?它是与格式化有关的错误吗? Is the code not well programmed somehow and not efficient or too heavy?代码是否以某种方式没有很好地编程,效率不高或太重? I don't know!我不知道!

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

This is exactly how the cells values become after I run the vba code:这正是我运行 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
    ...

As you can see the first part is how I want, and with the same running code the second part is not how I want.如您所见,第一部分是我想要的,而使用相同的运行代码,第二部分不是我想要的。 The month is changing and the formatting too, Bellow there are the original values of the column, which I simply what to change the repeating year!月份在变化,格式也在变化,下面是列的原始值,我只是简单地改变重复年份!

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

This is the desired result:这是期望的结果:

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

Further clarifications:进一步说明:

  • I get date as a result of =A2+1.我得到日期是 =A2+1 的结果。
  • The A column cells are all formatted like this dd-mm-aaaa A 列单元格的格式都像这样 dd-mm-aaaa
  • k is returning the right number. k 正在返回正确的数字。
  • The result should look like all the days and months remaining the same, and the repeating year 2022 changes to a year that starts in 2022 and decreases by one starting from the top down everytime it's December.结果应该看起来所有的日子和月份都保持不变,并且重复的 2022 年更改为从 2022 年开始的一年,每次到 12 月时从上到下减少一个。

The issue is if you use text/string functions like Mid() or Left() you change from a real numeric date (you can actually calculate with) to a text that only looks like a date but is just text (you cannot calculate with that anymore).问题是如果你使用像Mid()Left()这样的文本/字符串函数,你会从一个真正的数字日期(你可以实际计算)更改为一个看起来像日期但只是文本的文本(你不能用那个了)。 And Excel does not know that this is a date.而 Excel 不知道这是一个日期。

So whenever working with dates use numeric date functions like Day() , Month() and Year() to split the date into parts and use DateSerial(y, m, d) to put a new date together.因此,每当处理日期时,请使用Day()Month()Year()等数字日期函数将日期拆分为多个部分,并使用DateSerial(y, m, d)将新日期放在一起。 This will create a real numeric date you can calculate with, and that you can format with .NumberFormat .这将创建一个您可以计算的真实数字日期,并且您可以使用.NumberFormat进行格式化。

I changed your Do loop into a For loop that auto increments o on Next o , this looks a bit cleaner.我将您的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

Manipulate Dates in Column操作列中的日期

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

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM