使用VBA根据条件查找并填写其他Excel工作表

Question

我有一本包含四个工作表的工作簿：概述，苹果，香蕉和梨。 在工作表概述中，我有一个3x3的表格：

        In      Out      Extra
apple   
banana  
pear    

概述中的单元格H5包含日期为2019，可以通过下拉菜单选择该日期

在每个苹果/香蕉/梨纸中，我有一个365x3的表格：

               In      Out        Extra
1-1-2019
2-1-2019
3-1-2019
.
.
.
31-12-2019  

我想运行一个宏，以便将“概述”表中的“输入”，“输出”和“额外”值填充到正确的工作表中，并在该工作表中正确的日期后面。

目的是让人们填写概述表（In，Out和Extra值以及日期），然后运行宏，然后数据将自动存储在正确工作表的正确单元格中。

这是一个相对简单的示例，我需要此宏的实际工作簿中有70多个“水果”。

我知道下面的代码行不通，但我希望能展示出我的思维方式

Sub export()

Dim ws As Worksheet             'worksheet
    Dim currentdate As Date         'datum
    Dim fruit As String             'Fruit

    Worksheets("Overview").Activate                 'activate worksheet Overview
    currentdate = ActiveSheet.Cells(H5)             'select date value
fruit = Overview.Range(“C6, C8”)                'select range of the fruits


    For Each ws In Worksheets                           'loop over every worksheet except the Overview sheet
        If ws.Name = fruit Then                         'crossreference name worksheet with fruit in Overview sheet
            ws.Activate                                 'activating the selected worksheet
            If ws.Range("A1:A365") = currentdate Then   'looking for the correct date in the selcted worksheet
                fruit = ws.Name
    Next ws

    End Sub

Answer 1

Vba解决方案：

为了使该解决方案正常工作，应使工作表APPLE，BANANA和PEAR具有相同的结构。 在我的示例中，所有这三张纸在A列中都有日期，B列是IN ，C列是OUT ，D列是EXTRA

同样，在“概述”表中，确保术语“苹果”，“香蕉”和“梨”与每个表的名称完全相同 （这意味着没有多余的空格，空格或不同的字符）。

概述必须是活动工作表。

我的按钮IMPORT链接到此代码以导入数据。 我想从2019年5月17日导入数据（黄色行）

Sub IMPORT_DATA()
Application.ScreenUpdating = False
Range("B2:D4").Clear

Dim i As Long
Dim TargetRow As Long
Dim TargetSheet As String
Dim TargetDate As Date

TargetDate = Range("B6").Value

For i = 2 To Range("A" & Rows.Count).End(xlUp).Row Step 1 'i=2 because dats in OVERVIEW stars at row 2, and Column A
    TargetSheet = Range("A" & i).Value

    'first, we make sure the date from B6 exists in the target worksheet counting
    With Application.WorksheetFunction
        If .CountIf(ThisWorkbook.Worksheets(TargetSheet).Range("A:A"), TargetDate) > 0 Then
            TargetRow = .Match(CDbl(TargetDate), ThisWorkbook.Worksheets(TargetSheet).Range("A:A"), 0)
            Range("B" & i).Value = ThisWorkbook.Worksheets(TargetSheet).Range("B" & TargetRow).Value 'IN value
            Range("C" & i).Value = ThisWorkbook.Worksheets(TargetSheet).Range("C" & TargetRow).Value 'IN value
            Range("D" & i).Value = ThisWorkbook.Worksheets(TargetSheet).Range("D" & TargetRow).Value 'IN value
        End If
    End With
Next i
Application.ScreenUpdating = True
End sub

执行此代码后，我进入了概述：

现在，我想将一些值导出到数据，并使用以下代码：

Sub EXPORT_DATA()
Application.ScreenUpdating = False

Dim i As Long
Dim TargetRow As Long
Dim TargetSheet As String
Dim TargetDate As Date

TargetDate = Range("B6").Value

For i = 2 To Range("A" & Rows.Count).End(xlUp).Row Step 1 'i=2 because dats in OVERVIEW stars at row 2, and Column A
    TargetSheet = Range("A" & i).Value

    'first, we make sure the date from B6 exists in the target worksheet counting
    With Application.WorksheetFunction
        If .CountIf(ThisWorkbook.Worksheets(TargetSheet).Range("A:A"), TargetDate) > 0 Then
            TargetRow = .Match(CDbl(TargetDate), ThisWorkbook.Worksheets(TargetSheet).Range("A:A"), 0)
            ThisWorkbook.Worksheets(TargetSheet).Range("B" & TargetRow).Value = Range("B" & i).Value 'IN value
            ThisWorkbook.Worksheets(TargetSheet).Range("C" & TargetRow).Value = Range("C" & i).Value 'OUT value
            ThisWorkbook.Worksheets(TargetSheet).Range("D" & TargetRow).Value = Range("D" & i).Value 'EXTRA value
        End If
    End With
Next i

MsgBox "data exported"
Application.ScreenUpdating = True
End Sub

在执行代码之后，检查新数据（黄色行）：

希望这对您有所帮助，并且您可以适应自己的需求。