You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

VBA宏处理税年切换时触发‘Subscript out of range’错误排查

VBA宏税年边界数据处理报错问题

我正在编写一个VBA宏,功能是遍历排序表,为识别到的每个财年复制模板工作表,再将排序表中的数据粘贴到对应工作表的指定单元格中。

目前已实现遍历数据并为每个财年复制工作表的功能,也写好了遍历排序表的代码,能获取粘贴数据所需的变量:

  • 税年TY(用作工作表名称)
  • 财月(决定目标列)
  • 费用类型(决定目标列)
  • 待粘贴的现金金额Cash

通过FY函数(从DD.MM.YYYY格式的日期字符串返回财年)和FM函数(返回财月)生成粘贴坐标,核心粘贴代码如下:

Worksheets(TY).Cells(16, Cashcol).End(xlUp).Offset(1, 0).Value = Cash

其中TY是工作表对应的年份,16是目标区域的起始行,Cashcol是目标列,xlUp为内置常量。

代码在处理5月5日至次年4月30日的日期时运行正常(对应财月1至12),但由于税年周期为4月6日至次年4月5日,5月1日至4日的日期属于上一税年,此时FM函数会返回财月0。

为修复这个问题,我添加了以下代码:

If Cashmonth = 0 Then Backyear = True
  
If Backyear = True Then TY = FY(EDP) - 1
If Backyear = True Then Cashcol = 51

举个例子:日期03.05.2023属于2022税年的第12财月,需要把数据粘贴到名为2022的工作表第51列中第16行下方的第一个空单元格。

但当Backyear=True时,程序触发错误:

Subscript out of range

调试显示所有变量值都正确(TY=2022,Cashcol=51,Cash金额正确,xlUp返回-4162也正常),请问为什么这段仅在5月5天内触发的代码会导致原本正常的程序出错?

完整精简版代码

Option Explicit

Public Function FY(Fdate As String) As String
Dim arDMY As Variant

arDMY = Split(Fdate, ".")
If arDMY(1) >= 5 Then
   FY = CStr(arDMY(2) + 1)
Else
  FY = CStr(arDMY(2))
End If
End Function

Public Function FM(Fdate As String) As String
Dim arDMY As Variant
Dim TM As String
arDMY = Split(Fdate, ".")
If arDMY(1) >= 5 Then
   TM = CStr(arDMY(1) - 4)
Else
  TM = CStr(arDMY(1) + 8)
End If

If arDMY(0) >= 5 Then
   FM = TM
Else
  FM = TM - 1
End If
End Function

Sub Move_stuff()
Dim cell As Range
Dim Todate As Range
Dim Charge As Range
Dim Duedate As Range

Dim Sort_Table As Worksheet
Dim Template As Worksheet

Dim C As Variant
Dim D As Variant
Dim Targ As Range
Dim Ddate As Range
Dim Charge_Amount As Range
Dim Targdate As String
Dim EDP As String
Dim Cash As Double
Dim Backyear As Boolean
Dim Pos As Variant
Dim Cashmonth As String
Dim TY As Variant
Dim EDPM As Variant
Dim Cashcol As Long

Dim Year As Variant
Dim Month As Variant
Dim shtcount As Long

Set Todate = Range("Sorttable[To Date]")
Set Charge = Range("Sorttable[Charge Type]")
Set Duedate = Range("Sorttable[Due Date]")

Sheets("Sort_Table").Select  'select worksheet

For Each cell In Charge  'loop to find charge type
  If Not IsEmpty(cell) Then
   C = cell.Value
   D = CType(C)
   
   Set Targ = cell.Offset(, 3)
   Set Ddate = cell.Offset(, 2)
   Set Charge_Amount = cell.Offset(, 4)
   Targdate = Targ.Value
   EDP = Ddate.Value
   Cash = Charge_Amount.Value
   Backyear = False
   
    If D = "Cash" Then
               
      Cashmonth = FM(EDP)
       TY = FY(EDP)
       EDPM = FM(EDP) + (FM(EDP) - 1)
       Cashcol = 28 + EDPM
       If Cashmonth = 0 Then Backyear = True
      
       If Backyear = True Then TY = FY(EDP) - 1
       If Backyear = True Then Cashcol = 51
    
       Worksheets(TY).Cells(16, Cashcol).End(xlUp).Offset(1, 0).Value = Cash
       Worksheets(TY).Cells(16, Cashcol - 1).End(xlUp).Offset(1, 0).Value = EDP

'Elseif
    'Another bit of unrelated code that works
'Elseif
    'Another bit of unrelated code that works
'Elseif
    'Another bit of unrelated code that works

'Else 
    'Another bit of unrelated code that works

Worksheets("Sort_Table").Select
End if
End if
Next Cell
End Sub

内容的提问来源于stack exchange,提问作者Captain Kriegwurst

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.07.05 15:27:18