按日期从一个工作表复制粘贴到膏膏。

Question

我有一个月的日子，从单元格A到AH (例如: 1.1.2021是A，2.1.2021是B等等)，我需要将这些值复制到另一个工作表中。我的代码可以工作，但在所有31天中都太长了(错误:函数太大了)。有任何方法来优化它或按数组对其排序吗？在其他日子里，它的相同代码(除了从它得到值的部分)现在从"jan“工作表单元格"C”中得到，如果是第二天，它应该从单元格"D“(例如:每月的第一天:工作表(”List1“).Range(”I16“).Value=工作表(”Jan“).Range(”C10“).Value；每月的第二天:工作表(”List1“).Range(”I16“).Value=工作表(”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

Answer 1

按月和日分列的数据

注意:你在给Y7.和D16写C16

标准模块，如

Option Explicit

Sub ImportData()

    Const sfCol As Variant = "C" ' or 3
    Dim sRows As Variant: sRows = VBA.Array( _
        10, 18, 12, 11, 23, 7, 19, 3, 16, 4, _
        17, 5, 2, 16, 15, 9, 8, 21)
        
    Const dName As String = "List1"
    Const dMonthAddress As String = "V5"
    Const dDayAddress As String = "V6"
    Dim dAddresses As Variant: dAddresses = VBA.Array( _
        "I16", "N6", "T5", "T6", "T7", "D6", "D7", "Z7", "Y7", "Z6", _
        "Y6", "N7", "M16", "D16", "Y9", "N11", "Z8", "Y8")
    Dim dMonths As Variant: dMonths = VBA.Array( _
        "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", _
        "Nov", "Dec")
        
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim dws As Worksheet
    On Error Resume Next
    Set dws = wb.Worksheets(dName)
    On Error GoTo 0
    If dws Is Nothing Then
        MsgBox "Destination worksheet not found."
        Exit Sub
    End If
    
    Dim dMonth As Variant: dMonth = dws.Range(dMonthAddress).Value
    If IsNumeric(dMonth) Then
        dMonth = CLng(dMonth)
    Else
        MsgBox "Month is invalid"
        Exit Sub
    End If
    If dMonth < 1 Or dMonth > 12 Then
        MsgBox "Month is out of bounds."
        Exit Sub
    End If
    
    Dim dDay As Variant: dDay = dws.Range(dDayAddress).Value
    If IsNumeric(dDay) Then
        dDay = CLng(dDay)
    Else
        MsgBox "Day is invalid."
        Exit Sub
    End If
    If dDay < 1 Or dDay > 31 Then
        MsgBox "Day is out of bounds."
        Exit Sub
    End If
    
    Dim sws As Worksheet
    On Error Resume Next
    Set sws = dws.Parent.Worksheets(Application.Index(dMonths, dMonth))
    On Error GoTo 0
    If sws Is Nothing Then
        MsgBox "Month worksheet does not exist."
        Exit Sub
    End If
    
    Dim sCol As Long: sCol = sws.Columns(sfCol).Offset(, dDay - 1).Column
    
    Dim sUpper As Long: sUpper = UBound(sRows)
    Dim n As Long
    For n = 0 To sUpper
        dws.Range(dAddresses(n)).Value = sws.Cells(sRows(n), sCol).Value
    Next n

End Sub

• 您可以使用下面的.

自动化前面的内容

单模块，例如

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Const dMonthAddress As String = "V5"
    Const dDayAddress As String = "V6"

    Dim rg As Range: Set rg = Union(Range(dMonthAddress), Range(dDayAddress))
    If Not Intersect(Target, rg) Is Nothing Then
        ImportData
    End If

End Sub

现在，当您更改或V6中的值时，目标工作表将自动更新。

Answer 2

这就是我对这个问题的看法：

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

每一天或每月的变化都要运行这个程序。以月份为基础的表格应该存在。没有考虑错误处理。不需要重复密码。

Answer 3

为了说明我的意见：

   Sub TEST()
        Dim Day As Long, Month As Long
        Day = Range("V6").Value
        Month = Range("V5").Value ' Not sure what you are doing with this one?
        Worksheets("List1").Range("I16").Value = Worksheets("Jan").Cells(10, Day + 2).Value
        Worksheets("List1").Range("N6").Value = Worksheets("Jan").Cells(18, Day + 2).Value
        Worksheets("List1").Range("T5").Value = Worksheets("Jan").Cells(12, Day + 2).Value
        Worksheets("List1").Range("T6").Value = Worksheets("Jan").Cells(11, Day + 2).Value
        Worksheets("List1").Range("T7").Value = Worksheets("Jan").Cells(23, Day + 2).Value
        Worksheets("List1").Range("D6").Value = Worksheets("Jan").Cells(7, Day + 2).Value
        Worksheets("List1").Range("D7").Value = Worksheets("Jan").Cells(19, Day + 2).Value
        Worksheets("List1").Range("Z7").Value = Worksheets("Jan").Cells(3, Day + 2).Value
        Worksheets("List1").Range("Y7").Value = Worksheets("Jan").Cells(16, Day + 2).Value
        Worksheets("List1").Range("Z6").Value = Worksheets("Jan").Cells(4, Day + 2).Value
        Worksheets("List1").Range("Y6").Value = Worksheets("Jan").Cells(17, Day + 2).Value
        Worksheets("List1").Range("N7").Value = Worksheets("Jan").Cells(5, Day + 2).Value
        Worksheets("List1").Range("M16").Value = Worksheets("Jan").Cells(2, Day + 2).Value
        Worksheets("List1").Range("D16").Value = Worksheets("Jan").Cells(16, Day + 2).Value
        Worksheets("List1").Range("Y9").Value = Worksheets("Jan").Cells(15, Day + 2).Value
        Worksheets("List1").Range("N11").Value = Worksheets("Jan").Cells(9, Day + 2).Value
        Worksheets("List1").Range("Z8").Value = Worksheets("Jan").Cells(8, Day + 2).Value
        Worksheets("List1").Range("Y8").Value = Worksheets("Jan").Cells(21, Day + 2).Value
    End Sub

但是是的，您也可以将数据放在数组中等等。

如果不更好地理解数据，很难在这里看到很大的一种模式来缩短它。

如果只是引用另一个工作表，并且如果这些工作表是有序的，那么同样的想法可以应用于月份值。例如，如果"Jan“是第2页，而"Feb”是第3页，等等：

 Worksheets("List1").Range("I16").Value = Worksheets(Month + 1).Cells(10, Day + 2).Value