VBA以最少的编辑实现了更好的脚本

Question

此脚本在激光机上用于在产品上添加日期和与月/年相关的字母。代码中有一个需要遵循的循环。我试过在一个在线VB编译器上做这段代码，但只得到了错误。我想注意的是，这个代码在用于将密钥代码放在产品上的软件中确实有效。Q和我需要从代码中省略，是的，我知道2001年的代码中有一个I，这是错误的。月份有2个周期当前周期为2，2020年1月将再次为1个周期，这意味着2020年12月1日将是省略I和Q的字母N-Z。(2019年11月17日更正(2020年1月份将以A-M而非N-Z开头，省略I。

Project.ProcessActiveItem
Document.Show
Project.UpdateViews
End Sub
strWeekday = "%d"
strMOnth = Month(Now)
strYear = Year(Now)
If strMOnth = "1" Then strMOnthLetter = "N" End If
If strMOnth = "2" Then strMOnthLetter = "O" End If
If strMOnth = "3" Then strMOnthLetter = "P" End If
If strMOnth = "4" Then strMOnthLetter = "R" End If
If strMOnth = "5" Then strMOnthLetter = "S" End If
If strMOnth = "6" Then strMOnthLetter = "T" End If
If strMOnth = "7" Then strMOnthLetter = "U" End If
If strMOnth = "8" Then strMOnthLetter = "V" End If
If strMOnth = "9" Then strMOnthLetter = "W" End If
If strMOnth = "10" Then strMOnthLetter = "X" End If
If strMOnth = "11" Then strMOnthLetter = "Y" End If
If strMOnth = "12" Then strMOnthLetter = "Z" End If
If strYear = "1996" Then strYearLetter = "D" End If
If strYear = "1997" Then strYearLetter = "E" End If
If strYear = "1998" Then strYearLetter = "F" End If
If strYear = "1999" Then strYearLetter = "G" End If
If strYear = "2000" Then strYearLetter = "H" End If
If strYear = "2001" Then strYearLetter = "I" End If
If strYear = "2002" Then strYearLetter = "J" End If
If strYear = "2003" Then strYearLetter = "K" End If
If strYear = "2004" Then strYearLetter = "M" End If
If strYear = "2005" Then strYearLetter = "N" End If
If strYear = "2006" Then strYearLetter = "O" End If
If strYear = "2007" Then strYearLetter = "P" End If
If strYear = "2008" Then strYearLetter = "R" End If
If strYear = "2009" Then strYearLetter = "S" End If
If strYear = "2010" Then strYearLetter = "T" End If
If strYear = "2011" Then strYearLetter = "U" End If
If strYear = "2012" Then strYearLetter = "V" End If
If strYear = "2013" Then strYearLetter = "W" End If
If strYear = "2014" Then strYearLetter = "X" End If
If strYear = "2015" Then strYearLetter = "Y" End If
If strYear = "2016" Then strYearLetter = "Z" End If
If strYear = "2017" Then strYearLetter = "A" End If
If strYear = "2018" Then strYearLetter = "B" End If
If strYear = "2019" Then strYearLetter = "C" End If
Set YWWS1 = Document.CreateString(5)
YWWS1.Text = strWeekday & strMOnthLetter & strYearLetter
YWWS1.Update
Set YWWS2 = Document.CreateString(6)
YWWS2.Text = strWeekday & strMOnthLetter & strYearLetter
YWWS2.Update

Document.Show
Project.UpdateViews

Answer 1

假设2017年是我们的原点，分配字母和数字的通用公式保持不变：即：2020应该是D

我们可以在26之前将差值和余数转换为年，以确定我们处于迭代的哪个点

例如，2020年是2017年之后的3年(将该值调整1，因为2020-2017年是零基数，A-Z以1开头(。

3+1=4意味着我们应该提供CCD_ 2。

通过使用ASCII/CHR转换，我们可以简单地在余数值+1上加64，得到当年迭代的字母。

类似的逻辑用于几个月，但假设代码是恒定的(从N开始的偏移量通过在转换前将ASCII值加14来说明(。如果这些迭代让我知道，我们可以根据迭代模式进行调整。

我会将您的代码更新为以下内容：

Project.ProcessActiveItem
Document.Show
Project.UpdateViews
End Sub
strWeekday = "%d"
'strYear = year(Now)
'strMonth = Month(Now)
Dim intYear As Integer: intYear = year(Now)
Dim intMonth As Integer: intMonth = Month(Now)
Dim intYearIter As Integer
Dim intMonthIter As Integer
'Get current month and add 14 to align with sequence
intMonthIter = Month(Now) + 14
'If current month iteration is 17 (Q) skip to next
If intMonthIter = 17 Then
intMonthIter = intMonthIter + 1
End If
strMonthLetter = Chr(intMonthIter + 64)
'Get iteration of supplied year
If intYear >= 2017 Then
intYearIter = (intYear - 2017 + 1) Mod 26
Else
intYearIter = 26 - ((2017 - intYear + 1) Mod 26)
End If
'If iteration is 17(Q) or 9(I) skip to next
If intYearIter = 17 Or intYearIter = 9 Then
intYearIter = intYearIter + 1
End If
strYearLetter = Chr(intYearIter + 64)
Set YWWS1 = Document.CreateString(5)
YWWS1.Text = strWeekday & strMOnthLetter & strYearLetter
YWWS1.Update
Set YWWS2 = Document.CreateString(6)
YWWS2.Text = strWeekday & strMOnthLetter & strYearLetter
YWWS2.Update

Document.Show
Project.UpdateViews

Answer 2

用一个函数替换大部分代码，该函数将代码存储在数组中，并根据当前月份和年份对数组进行索引。通过这种方式，代码是灵活的，因为它们不具有顺序的，以后可以添加更多的代码。

Public Function GetDateCode() As String
Dim strMoLetter() As Variant, strYrLetter() As Variant
strMoLetter = Array("N", "O", "P", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
strYrLetter = Array("D", "E", "F", "G", "H", "I", "J", "K", "M", "N", "O", "P", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "A", "B", "C")
Dim intMo As Long, intYr As Long
intMo = Month(Now): intYr = Year(Now)
GetDateCode = "%d" & strMoLetter(intMo - 1) & strYrLetter(intYr - 1996)
End Function

_{注意，在这种情况下，字母"L"one_answers"Q"缺失}

现在调用这个函数如下

Dim code As String
code = GetDateCode()
Set YWWS1 = Document.CreateString(5)
YWWS1.Text = code
YWWS1.Update
Set YWWS2 = Document.CreateString(6)
YWWS2.Text = code
YWWS2.Update

Document.Show
Project.UpdateViews