Question

去年，我制作了一个巨大的电子表格，其中包含世界上每个国家/地区的所有最新可用数据。我的想法是，我可以下载最新数据 - 例如，包含世界银行人口统计数据的数据表 - 并轻松将其传输到我的主页。

以下是一个示例：

为了从其他电子表格中提取数据，我使用了冗长，混乱的IF函数行，例如：

=IF(ISNUMBER(IFERROR(VLOOKUP($A3;Population!$A$3:$C$400;2;FALSE);"Not 
Found"));IFERROR(VLOOKUP($A3;Population!$A$3:$C$400;2;FALSE);"Not 
Found");"Not Found")&" 
("&IF(ISNUMBER(IFERROR(VLOOKUP($A3;Population!$A$3:$C$400;3;FALSE);"Not 
Found"));IFERROR(VLOOKUP($A3;Population!$A$3:$C$400;3;FALSE);"Not 
Found");"Not Found")&")"

显然，这不是最有效的方法。这是我需要宏做的事情：

首先在我的主工作表中匹配包含所有国家/地区名称的A列，数据表中包含A列，其中包含特定于此数据集的国家/地区。
然后将数据表中的最新数据（最右边的非空白单元格）复制粘贴到主页中的适当位置（即乌干达与乌干达匹配）。
粘贴的数据还必须在括号中包含各自的年份（在图片中，所有数据都来自2016年，但情况并非总是如此）。

我已经尝试了一些循环来尝试复制上面提到的IF函数，但似乎没有什么对我有用。到目前为止，我的尝试让我想到了这个：

Option Explicit

Sub test()

Dim data As Worksheet
Dim report As Worksheet
Dim finalrow As Integer
Dim finalcol As Integer
Dim rngMatch As Range
Dim i As Integer
Dim countryname As String

Set data = Ark2
Set report = Ark1

countryname = data.Range("A5").Value

report.Range("B2:CC300").ClearContents

data.Select
finalrow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To finalrow
    If Cells(i, 1) = countryname Then
    Cells(i, 5).Copy
    report.Select
    Range("B300").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
    data.Select
    End If

Next i

report.Select

End Sub

这里存在许多缺陷，并没有解决我的问题。任何人都可以指出我在正确的方向做什么？

感谢您的时间。

Answer 1

这是一个循环：

遍历主工作簿中的A列（国家/地区名称）
将在您的数据工作簿中查找此国家/地区
获取找到的行的最后一个使用的列（如果找到值）

在直接窗口中打印值，显然你必须调整那段代码

Sub Test()

Dim RNG1 As Range, CL1 As Range
Dim LR1 As Long, LR2 As Long, LC As Long

LR1 = Workbooks("MainWB").Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
LR2 = Workbooks("DataWB").Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
Workbooks("DataWB").Activate
Set RNG1 = Workbooks("DataWB").Sheets(1).Range(Cells(1, 1), Cells(LR2, 1))

For X = 3 To LR1
    With RNG1
        Set CL1 = .Find(What:=Workbooks("MainWB").Sheets(1).Cells(X, 1).Value, LookIn:=xlValues, LookAt:=xlWhole)
        If Not CL1 Is Nothing Then
            LC = Workbooks("DataWB").Sheets(1).Cells(CL1.Row, Columns.Count).End(xlToLeft) + 1
            Debug.Print Workbooks("DataWB").Sheets(1).Cells(CL1.Row, LC).Value 'Do something else with this value obviously
        End If
    End With
Next X

Workbooks("MainWB").activate
End Sub

您显然需要根据需要调整所有变量和名称。希望你能找到有用的点点滴滴。

Answer 2

编辑 - 正如JvdV指出的那样，复制粘贴并不是必需的，所以我将代码更改为report.Sheets[...].Value = data.Sheets[...].Value，这要快得多。再次感谢JvdV。

所以，在JvdV的帮助下，我能够拼凑一个宏，对我来说效果很好。

Sub extract()

Dim RNG1 As Range, CL1 As Range
Dim LR1 As Long, LR2 As Long, LC As Long

Set report = Workbooks("Main.xlsm")
Set data = Workbooks("API_NE.EXP.GNFS.CD_DS2_en_excel_v2_9944773.xls")

report.Sheets("Report").Activate
data.Sheets("Data").Activate

LR1 = report.Sheets("Report").Cells(Rows.Count, 1).End(xlUp).Row
LR2 = data.Sheets("Data").Cells(Rows.Count, 1).End(xlUp).Row
RC2 = report.Sheets("Report").Cells(LR1, Columns.Count).End(xlToLeft).Column + 1
RC3 = RC2 + 1

Set RNG1 = data.Sheets("Data").Range(Cells(1, 1), Cells(LR2, 1))
report.Sheets("Report").Cells(1, RC2).Value = data.Sheets("Data").Cells(5, 3).Value
report.Sheets("Report").Cells(1, RC3).Value = "Year"

For X = 2 To LR1
    With RNG1
        Set CL1 = .Find(What:=report.Sheets("Report").Cells(X, 1).Value, LookIn:=xlValues, LookAt:=xlWhole)
        If Not CL1 Is Nothing Then
            LC1 = data.Sheets("Data").Cells(CL1.Row, Columns.Count).End(xlToLeft).Column
            If IsNumeric(data.Sheets("Data").Cells(CL1.Row, LC1)) Then
                report.Sheets("Report").Cells(LR1, RC2).End(xlUp).Offset(1, 0).Value = data.Sheets("Data").Cells(CL1.Row, LC1).Value
            Else
                report.Sheets("Report").Cells(LR1, RC2).End(xlUp).Offset(1, 0).Value = "N/A"
            End If

            If IsNumeric(data.Sheets("Data").Cells(CL1.Row, LC1)) Then
                report.Sheets("Report").Cells(LR1, RC3).End(xlUp).Offset(1, 0).Value = data.Sheets("Data").Cells(4, LC1).Value
            Else
                report.Sheets("Report").Cells(LR1, RC3).End(xlUp).Offset(1, 0).Value = "N/A"
            End If


        End If
    End With
Next X

report.Sheets("Report").Activate

With Worksheets("Report").Columns(RC2)
    .NumberFormat = "0.00"
    .Value = .Value
End With

With Worksheets("Report").Columns(RC3)
    .NumberFormat = "0"
    .Value = .Value
End With

End Sub

此宏允许您从时间序列中提取最新数据，以及数据点的相应年份。在此特定宏中，您可以从世界银行提供的任何电子表格中复制任何国家/地区的数据。你所要做的就是：

插入工作簿的名称（例如，＆＃34; Main.xlsm＆＃34;）以及来自世界银行的工作簿名称（例如，＆＃34; API_NE.EXP.GNFS.CD_DS2_en_excel_v2_9944773的.xls＆＃34）
将您感兴趣的国家/地区命名为自己工作簿的A列。
让宏运行
从世界银行插入新工作簿
让宏再次运行
等

宏不会覆盖以前的数据，而是复制最右列中的数据点和样本年份。可以在下面看到一个宏的实例。

Example of the macro

VBA Macro想要 - 将数据从一个工作表复制到另一个工作表

2 个答案: