VBA從一張紙中獲取信息並將其復制到另一張紙上

Question

我的sheet_one看起來像這樣：

    2020-01-31
A   2
B   3
C   10

我的sheet_two看起來像這樣：

    2019-12-31  2020-01-31  2020-02-29  2020-03-31  2020-04-30  2020-05-31  2020-06-30  2020-07-31  2020-08-31  2020-09-30  2020-10-31  2020-11-30  2020-12-31
A                                                   
B                                                   
C                                                   

如何將信息從第一張紙復制到第二張紙？

謝謝你的建議。

Answer 1

您可以修改和使用以下內容：

Sub test()

    Dim rngDate As Range, rngLetter As Range
    Dim dDate As Date
    Dim LastRow As Long, LastColumn As Long, i As Long, y As Long
    Dim Letter As String, strValue As String

    With ThisWorkbook.Worksheets("Sheet1")

        'Let as assume that Column A includes the letters. Find LastRow
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        'Let as assume that Row 1 includes the Dates. Find LastColumn
        LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
        'Test if there available Dates
        If LastColumn > 1 Then
            'Test if there available Letters
            If LastRow > 1 Then
                'Loop Dates
                For i = 2 To LastColumn
                    'Set dDate
                    dDate = .Cells(1, i).Value
                    'Loop Letters
                    For y = 2 To LastRow
                        'Set Letter
                        Letter = .Cells(y, 1).Value
                        'Set Value to import
                        strValue = .Cells(y, i).Value
                        'Search in Sheet2
                        With ThisWorkbook.Worksheets("Sheet2")
                            'Let as assume that Row 1 includes the Dates
                            'Search for the dDate in Row 1
                            Set rngDate = .Rows(1).Find(What:=dDate, LookIn:=xlValues, lookat:=xlPart)
                            'Check if date found
                            If Not rngDate Is Nothing Then
                                'Search for the Letter in Column A
                                Set rngLetter = .Columns(1).Find(What:=Letter, LookIn:=xlValues, lookat:=xlPart)

                                If Not rngDate Is Nothing Then
                                    'Import Value
                                    .Cells(rngLetter.Row, rngDate.Column).Value = strValue
                                Else
                                    MsgBox "Letter not found"
                                End If

                            Else
                                MsgBox "Date not found"
                            End If

                        End With

                    Next y

                Next i

            End If

        End If

    End With

End Sub