首页 > 解决方案 > 按日期从一个工作表复制粘贴到另一个工作表

问题描述

我一个月中有几天从单元格 A 到 AH 排序(例如:1.1.2021 是 A,2.1.2021 是 B 等等),我需要将这些值复制到另一个工作表。我的代码有效,但是对于所有 31 天来说都太长了(错误:函数太大)。有没有办法优化它或按数组排序?在其他日子里,它的代码相同,除了它现在从“jan”工作表单元格“C”获取值的部分,如果它是第二天,它应该从单元格“D”获取值,例如: 一个月的第一天:工作表( "List1").Range("I16").Value = Worksheets("Jan").Range("C10").Value; 每月的第二天: Worksheets("List1").Range("I16").Value = Worksheets("Jan").Range("D10").Value

代码如下所示:

Function TEST()
    Dim Day, Month As Variant
    Day = Range("V6").Value
    Month = Range("V5").Value

    If Month = 1 Then
        Worksheets("List1").Range("I16").Value = Worksheets("Jan").Range("C10").Value 
        Worksheets("List1").Range("N6").Value = Worksheets("Jan").Range("C18").Value 
        Worksheets("List1").Range("T5").Value = Worksheets("Jan").Range("C12").Value 
        Worksheets("List1").Range("T6").Value = Worksheets("Jan").Range("C11").Value 
        Worksheets("List1").Range("T7").Value = Worksheets("Jan").Range("C23").Value 
        Worksheets("List1").Range("D6").Value = Worksheets("Jan").Range("C7").Value 
        Worksheets("List1").Range("D7").Value = Worksheets("Jan").Range("C19").Value 
        Worksheets("List1").Range("Z7").Value = Worksheets("Jan").Range("C3").Value 
        Worksheets("List1").Range("Y7").Value = Worksheets("Jan").Range("C16").Value 
        Worksheets("List1").Range("Z6").Value = Worksheets("Jan").Range("C4").Value 
        Worksheets("List1").Range("Y6").Value = Worksheets("Jan").Range("C17").Value 
        Worksheets("List1").Range("N7").Value = Worksheets("Jan").Range("C5").Value 
        Worksheets("List1").Range("M16").Value = Worksheets("Jan").Range("C2").Value 
        Worksheets("List1").Range("D16").Value = Worksheets("Jan").Range("C16").Value 
        Worksheets("List1").Range("Y9").Value = Worksheets("Jan").Range("C15").Value 
        Worksheets("List1").Range("N11").Value = Worksheets("Jan").Range("C9").Value 
        Worksheets("List1").Range("Z8").Value = Worksheets("Jan").Range("C8").Value 
        Worksheets("List1").Range("Y8").Value = Worksheets("Jan").Range("C21").Value 
    ElseIf Day = 2 Then
        Worksheets("List1").Range("I16").Value = Worksheets("Jan").Range("D10").Value 
        Worksheets("List1").Range("N6").Value = Worksheets("Jan").Range("D18").Value 
        '....etc
    End If
End Function

标签: excelvba

解决方案


这是我对这个问题的看法:

Sub TEST()
    Dim intDay, intMonth As Integer
    Dim d As Integer
    intDay = CInt(Range("V6").Value)
    intMonth = CInt(Range("V5").Value)
    
    ' get the abbreviated month name
    txtMonth = MonthName(intMonth, True)
    
    ' it seems that this is the output template
    Set shtList = ThisWorkbook.Worksheets("List1")
    
    ' make sure that sheet of month name exists
    Set shtMonth = ThisWorkbook.Worksheets(txtMonth)
        
    d = 2 + intDay     ' column index; e.g. d + Day = 2 + 1 = "C", 2 + 2 = "D"
    
    With shtList
        .Range("I16").Value = shtMonth.Cells(10, d).Value
        .Range("N6").Value = shtMonth.Cells(18, d).Value
        .Range("T5").Value = shtMonth.Cells(12, d).Value
        .Range("T6").Value = shtMonth.Cells(11, d).Value
        .Range("T7").Value = shtMonth.Cells(23, d).Value
        .Range("D6").Value = shtMonth.Cells(7, d).Value
        .Range("D7").Value = shtMonth.Cells(19, d).Value
        .Range("Z7").Value = shtMonth.Cells(3, d).Value
        .Range("Y7").Value = shtMonth.Cells(16, d).Value
        .Range("Z6").Value = shtMonth.Cells(4, d).Value
        .Range("Y6").Value = shtMonth.Cells(17, d).Value
        .Range("N7").Value = shtMonth.Cells(5, d).Value
        .Range("M16").Value = shtMonth.Cells(2, d).Value
        .Range("D16").Value = shtMonth.Cells(16, d).Value
        .Range("Y9").Value = shtMonth.Cells(15, d).Value
        .Range("N11").Value = shtMonth.Cells(9, d).Value
        .Range("Z8").Value = shtMonth.Cells(8, d).Value
        .Range("Y8").Value = shtMonth.Cells(21, d).Value
    End With
    
End Sub

每天或每月更改一次运行此程序。应该存在基于月份的工作表。没有考虑错误处理。无需重复代码。


推荐阅读