Excel VBA – 如果两个维度匹配，则通过多个工作表实现复制/粘贴值所需的二维循环逻辑
对于工作，我正在开发一个完全自动化的工具，可以从我们的金融企业工具（SAP）中提取摘要，并将这些值传递给财务电子表格用于报告目的。 为了达到这个目标，我select了编写一个电子表格来从SAP提取数据，对其进行标准化，然后将其转移到财务电子表格中。
我有3/4的方式，除了由于数据布局的复杂性，我无法弄清楚如何将数据从规范化的数据表（源代码）传输到财务电子表格（目的地）。
包含SAP数据的源表按以下方式sorting
1.列A – 行6至6000 – 包含人的名字
2.列A – AX – 第5行 – 包含过帐date
3. B6栏：AX6000 – 包含财务数据（注意范围不固定，是dynamic/可变范围）
包含财务数据的目标表格按以下方式sorting
1. E栏 – 行528至1268 – 包含人的名字
2.列A – AX – 第5行 – 包含过帐date
3. H528列：AX1260 – 包含财务数据（注意，此范围是固定的）
我想要的代码是看源和目标电子表格中的date。 如果它find两个匹配的date条目，然后查看名称。 如果发现名称匹配，则应该从源单元到目标单元之间购买与该名称和date相对应的财务数据。 一旦所有的名字都被扫描过了，就到源单元格的下一个date
这是我的目标
Source: NOTE: Micks entry in Column C, Line 8 ___|__A__||__B__| |__C__| |__D__| 5 |Date | 01/01| |01/02| |01/03| ---|-----|------|-|-----|-|-----| 6 |Jake | | | | | | ---|-----|------|-|-----|-|-----| 7 |Mike | | | | | | ---|-----|------|-|-----|-|-----| 8 |Mick | | |$222 | | | ---|-----|------|-|-----|-|-----| Original Target: ___|__E__||__I__| |__J__| |__K__| 5 | | 01/01| |01/02| |01/03| ---|-----|------|-|-----|-|-----| 528|Jake | $540| | $444| | | ---|-----|------|-|-----|-|-----| 529|Mike | $423| | $282| | | ---|-----|------|-|-----|-|-----| 530|Mick | $452| | $523| | | ---|-----|------|-|-----|-|-----| New Target: Note Micks entry in Column J, Row 530 ___|__E__||__I__| |__J__| |__K__| 5 |Date | 01/01| |01/02| |01/03| ---|-----|------|-|-----|-|-----| 528|Jake | $540| | $444| | | ---|-----|------|-|-----|-|-----| 529|Mike | $423| | $282| | | ---|-----|------|-|-----|-|-----| 530|Mick | $452| | $222| | | ---|-----|------|-|-----|-|-----| 我已经尝试了下面的代码为了做到这一点，但它不会产生一个结果，我卡住了，我可能会出错哪里的任何build议？ 我已经使用并略微改变了下面的Tims范围，这个答案已经到了，但是mr和mc范围最终没有返回任何值。
目前的代码如下：
Sub Tester() MapValues Worksheets("Source").Range("A5").CurrentRegion, Worksheets("Target").Range("E528").CurrentRegion End Sub Sub MapValues(rngSource As Range, rngDest As Range) Dim r As Long, c As Long Dim mr As Range, mc As Range, srcCell As Range For r = 2 To rngDest.Rows.Count For c = 2 To rngDest.Columns.Count 'match doesn't work on dates so using Find() Set mr = rngSource.Columns(1).Find(rngDest.Cells(r, 1).Value, _ LookIn:=xlValues, Lookat:=xlWhole) Set mc = rngSource.Rows(1).Find(rngDest.Cells(1, c).Value, _ LookIn:=xlValues, Lookat:=xlWhole) If Not mr Is Nothing And Not mc Is Nothing Then 'locate the matching cell in the source block Set srcCell = rngSource.Parent.Cells(mr.Row, mc.Column) 'copying only if there's a value in "source" If Len(srcCell.Value) > 0 Then rngDest.Cells(r, c).Value = srcCell.Value End If End If Next c Next r End Sub
以下是一个简单的二维查找示例：
Sub Tester() MapValues Range("A1").CurrentRegion, Range("A16").CurrentRegion End Sub Sub MapValues(rngSource As Range, rngDest As Range) Dim r As Long, c As Long Dim mr As Range, mc As Range, srcCell As Range For r = 2 To rngDest.Rows.Count For c = 2 To rngDest.Columns.Count 'match doesn't work on dates so using Find() Set mr = rngSource.Columns(1).Find(rngDest.Cells(r, 1).Value, _ LookIn:=xlValues, Lookat:=xlWhole) Set mc = rngSource.Rows(1).Find(rngDest.Cells(1, c).Value, _ LookIn:=xlValues, Lookat:=xlWhole) If Not mr Is Nothing And Not mc Is Nothing Then 'locate the matching cell in the source block Set srcCell = rngSource.Parent.Cells(mr.Row, mc.Column) 'copying only if there's a value in "source" If Len(srcCell.Value) > 0 Then rngDest.Cells(r, c).Value = srcCell.Value End If End If Next c Next r End Sub
“来源”和“目的地”的范围与“之前”和“之后”运行testing程序：
