使用 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 值填充到正确的工作表中，并在该工作表中的正确日期之后。

目标是人们填写概览表（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 共享相同的结构。在我的示例中，所有这 3 张工作表在 A 列中都有日期，B 列是 IN，C 列是 OUT，D 列是 EXTRA

此外，在 OVERVIEW 表中，确保 APPLE、BANANA 和 PEAR 等术语完全与每张表的名称相同（这意味着没有多余的空格、空格或不同的字符）。

OVERVIEW 必须是活动工作表。

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

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

执行此代码后，我进入 OVERVIEW：

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

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

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

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