[英]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:进一步说明:
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
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.