VBA - 匹配范围以查看单元格值是否在数组中

时间:2014-10-02 17:35:09

标签: arrays excel vba excel-vba

ISOmatch包含数组sISO和sISOnew中的所有值。我希望将大约200个不同工作簿中的值复制到一个文件中。 ISOmnatch是数组中所有ISO代码的列。

我试图让它遍历每本书,复制一个值,找到ISO匹配并粘贴该值,然后转到下一本书,找到iso匹配等。

这是我到目前为止编写的代码。我正在讨论的主要问题是如何检测是否存在匹配,例如"如果cell.value = sISO()或sISOnew()那么"。我不太确定如何实现嵌入式excel匹配功能,或者这更容易。

    Sub NTSDM_Econ()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim isoWF, isoNWF As String
Dim sISO As Variant
Dim sISOnew As Variant

isoWF = "J:\Washington\Groups\CIG\GRS\Workfiles\"
isoNWF = "J:\Washington\Groups\CIG\GRS\Workfiles\New Countries\"

sISO = Array( _
"AFG", "AGO", "ALB", "ARE", "ARG", "ARM", "AUS", "AUT", "AZE", "BDI", "BEL", "BFA", "BGD", _
"BGR", "BHR", "BIH", "BLR", "BOL", "BRA", "BTN", "BWA", "CAN", "CHE", "CHL", "CHN", _
"CIV", "CMR", "COG", "COL", "CRI", "CUB", "CYP", "CZE", "DEU", "DNK", "DOM", "DRC", "DZA", _
"ECU", "EGY", "ESP", "EST", "FIN", "FRA", "GAB", "GBR", "GEO", "GHA", "GIN", "GNQ", "GRC", _
"GTM", "HKG", "HND", "HRV", "HUN", "IDN", "IND", "IRL", "IRN", "IRQ", "ISL", "ISR", "ITA", _
"JOR", "JPN", "KAZ", "KEN", "KGZ", "KHM", "KOR", "KOS", "KWT", "LAO", "LBN", "LBR", "LBY", _
"LKA", "LSO", "LTU", "LVA", "MAR", "MDA", "MDG", "MEX", "MKD", "MLI", "MMR", "MNE", "MNG", _
"MOZ", "MRT", "MUS", "MWI", "MYS", "NAM", "NCL", "NER", "NGA", "NIC", "NLD", "NOR", "NPL", _
"NZL", "OMN", "PAK", "PAN", "PER", "PHL", "PNG", "POL", "PRI", "PRT", "PRY", "QAT", "ROM", _
"RUS", "SAU", "SDN", "SEN", "SGP", "SLE", "SLV", "SRB", "SSD", "SVK", "SVN", _
"SWE", "SWZ", "SYR", "TGO", "THA", "TJK", "TKM", "TLS", "TTO", "TUN", "TUR", "TWN", "TZA", _
"UGA", "UKR", "URY", "USA", "UZB", "VEN", "VNM", "YEM", "ZAF", "ZMB", "ZWE")

sISOnew = Array( _
"ABW", "AIA", "AND", "ASM", "ATG", "BEN", "BHS", "BLZ", "BMU", "BRB", "BRN", "CAF", "COM", _
"CPV", "CUW", "CYM", "DJI", "DMA", "ERI", "ETH", "FJI", "FSM", "GMB", "GNB", "GRD", "GUF", _
"GUM", "GUY", "HTI", "JAM", "KIR", "KNA", "LCA", "LIE", "LUX", "MAC", "MCO", "MDV", "MHL", _
"MLT", "MTQ", "NRU", "PLW", "PRK", "PSE", "REU", "RWA", "SLB", "SMR", "SOM", "STP", "SUR", _
"SXM", "SYC", "SYC", "TCD", "TON", "TUV", "VCT", "VIR", "VUT", "WSM")

' smaller array used to test
sISO = Array("AFG", "AGO")

For Each ctry In sISO
    For Each Cell In Range("B4:B214")
        If UBound(Filter(sISO, Cell.Value)) > -1 Then

            '' do some stuff

            ActiveWorkbook.Close
        End If
    Next
Next ctry

End Sub

2 个答案:

答案 0 :(得分:0)

您可以使用Filter()测试项目是否在数组中。 <{1}}代替If cell.value = sISO() or sISONew()这样的东西应该有用。

答案 1 :(得分:0)

您可以使用函数InStr()来查看值是否匹配,但是您需要将所有值都包含在字符串中。以下是可以执行此操作的代码部分。只需确保在进入循环之前填充数组

Dim ISOlist As String
Dim i As Long
Dim myVal As String

'Fill the two arrays into one long string with comma-separated values.
'The string need to make sure there is a comma both before and after each value
For i = LBound(sISO) To UBound(sISO)
    ISOlist = ISOlist & "," & sISO(i)
Next
For i = LBound(sISOnew) To UBound(sISOnew)
    ISOlist = ISOlist & "," & sISOnew(i)
Next
ISOlist = ISOlist & ","        'the ending comma is important

        'Get the value that I should test, adding a comma before and after
        myVal = "," & cell.value & ","

        'If cell.Value = sISO() Or sISOnew() Then
        If InStr(myVal, ISOlist) > 0 Then