交叉引用两个数据集以得出一个解决方案的Excel VBA函数

raogr8fs 于 2023-02-17 发布在其他

关注(0)|答案(3)|浏览(105)

What I am trying to do is have a dynamic list of companies (I use data validation) that once chosen an impact number would be reported.
My data set consists of a list of companies and the associated country codes in which they operate (Company Table pic). The second data set has the country codes associated with the country name and the number of citizens in this country (Country Table pic).
A countries citizens are only impacted if 2 or more companies chosen are operating in that country.
Say I chose company 4 and company 6 in my drop down list (Company Selection pic). Since both these companies operate in "AZ" and "BJ", I'm trying to get the output cell to populate with 1,079.
I want this to be possible with up to 20 company selections.
I wanted to do this with an index match but I couldnt understand how I could get it to return an array. My thinking is that for each company selection I would start to build up a unique array which would be populated with each companies country of operation. Then after that array has been built from all chosen company locations I would then assess that array and see if any country code occurs 2 or more times. If it does then I could return those country codes and use them to sumifs on the second database.
Attempt Code:

Function Impact(CompanySelection As Range, CompanyTable As Range, CountryTable As Range)
Dim CountryCodes As Object
Dim LookupCountries As Object
Dim Results As Object
Dim CImpact As Long

Dim cell As Variable

For Each cell In CompanySelection.Range

    If cell.Value = "" Then
    Exit For

    CountryCodes.Add Application.WorksheetFunction.Index(CompanyTable, Application.WorksheetFunction.Match(cell, CompanyTable, 0), 2)
    CountryCodes.Add Application.WorksheetFunction.Index(CompanyTable, Application.WorksheetFunction.Match(cell, CompanyTable, 0), 3)
    CountryCodes.Add Application.WorksheetFunction.Index(CompanyTable, Application.WorksheetFunction.Match(cell, CompanyTable, 0), 4)
    CountryCodes.Add Application.WorksheetFunction.Index(CompanyTable, Application.WorksheetFunction.Match(cell, CompanyTable, 0), 5)

Next

For each cell in CountryCodes 

count # of occurances of each unique country code

If code in CountryCodes occurs >=2 Then
    LookupCountries.Add Value

For Each cell In LookupCountries

    Result.Add Application.WorksheetFunction.Index(CountryTable, 
Application.WorksheetFunction.Match(cell, CountryTable, 2))

Next

For Each cell In Result
CImpact = CImpact + cell.Value
Next

Impact = CImpact
End Function

Company table
| Company | Country | Country | Country |
| ------------ | ------------ | ------------ | ------------ |
| Company 1 | AO | BZ | BS |
| Company 2 | BW | AQ | AO |
| Company 3 | BA | BI | |
| Company 4 | BR | AZ | BJ |
| Company 5 | AI | | |
| Company 6 | AZ | BJ | BS |
Country Table
| Country | Citizens |
| ------------ | ------------ |
| AO | 582 |
| AI | 536 |
| AQ | 350 |
| AZ | 732 |
| BA | 408 |
| BI | 826 |
| BJ | 347 |
| BR | 767 |
| BS | 336 |
| BW | 604 |
| BW | 601 |
Company Selection
| Company Selection |
| ------------ |
| Company 4 |
| Company 6 |
| ... |
| ... |
| ... |
| ... |
Output Cell
| Impacted Citizens = |
| ------------ |

excel

来源：https://stackoverflow.com/questions/75461620/excel-vba-function-that-cross-references-two-data-sets-to-come-up-with-one-solut

3条答案

按热度按时间

alen0pnh1#

使用字典计数的解决方案

Public Sub citizens()
    Dim ix As Integer, c As Integer, key As Variant
    Dim companyLocations As Range, locations As Range
    Set locations = Range("locations") 'Table with locations by company
    Dim dicCountries As Object
    Set dicCountries = CreateObject("Scripting.Dictionary")
    
    For Each company In Range("companySelection") 'just the cells with the dropdown list
        ix = -1
        On Error Resume Next
        ix = WorksheetFunction.Match(company.Value, locations.Columns(1), 0)
        On Error GoTo 0
        
        If ix <> -1 Then
            Set companyLocations = locations.Rows(ix) 'Row that contains the the countries for that company
            For c = 2 To companyLocations.Columns.Count ' Check counties strating at column 2
                Key = Trim(companyLocations.Cells(1, c))
                If dicCountries.exists(Key) Then
                    dicCountries(Key) = dicCountries(Key) + 1
                Else
                    dicCountries(Key) = 1
                End If
            Next c
        End If
    Next company
    Dim citizens  As Long
    citizens = 0
    For Each Key In dicCountries.keys()
        If dicCountries(Key) > 1 Then
            citizens = citizens + WorksheetFunction.VLookup(Key, Range("countryTable"), 2, False)
        End If
    Next Key
    Range("e36").Value = citizens 'whatever cell you want the result
End Sub

``

赞(0）回复(0）举报 2023-02-17

8cdiaqws2#

我认为现在它是正确的。a）Concat每个公司的国家，B）concat选定公司的国家，c）检查每个国家是否存在twise在（b），d）设置公民在主表只有当国家存在twise。但VBA更灵活！

赞(0）回复(0）举报 2023-02-17

vsmadaxz3#

我使用了wrbp的解决方案，并做了一些修改以适应我的用例。

Public Sub citizens()
Dim companyLocations As Range, locations As Range
Set locations = Application.Workbooks("Test File.xlsm").Worksheets("Test").Range("A5:F45") 'Table with locations by company
Dim dicCountries As Object
Set dicCountries = CreateObject("Scripting.Dictionary")

Dim cell As Range
Dim i As Long

'For Each cell In locations.Columns(1).Cells
    'Debug.Print cell.Value
'Next cell

For Each company In Application.Workbooks("Macro Worksheet.xlsm").Worksheets("Test").Range("L5:L24").Cells 'just the cells with the dropdown list
    ix = -1

    On Error Resume Next
    'Debug.Print company
    ix = Application.WorksheetFunction.Match(company.Value, locations.Columns(1).Cells, 0)
    Debug.Print ix
    On Error GoTo 0
       
    If ix <> -1 Then
        Set companyLocations = locations.Rows(ix)
        For c = 2 To companyLocations.Columns.Count
            key = Trim(companyLocations.Cells(1, c))
            
            If key = "" Then
                Exit For
            
            ElseIf dicCountries.exists(key) Then
                dicCountries(key) = dicCountries(key) + 1
            Else
                dicCountries(key) = 1
            End If
        Next c
    End If

    
Next company
For Each key In dicCountries.Keys
   Debug.Print key, dicCountries(key)
Next key


Dim citizens  As Long
citizens = 0
For Each key In dicCountries.Keys()
    If dicCountries(key) > 1 Then
        Debug.Print WorksheetFunction.VLookup(key, Application.Workbooks("Macro Worksheet.xlsm").Worksheets("Test").Range("B49:C85"), 2, False)
        citizens = citizens + WorksheetFunction.VLookup(key, Application.Workbooks("Macro Worksheet.xlsm").Worksheets("Test").Range("B49:C85"), 2, False)
    End If
    
Next key
Range("H1").Value = citizens 'whatever cell you want the result
End Sub

赞(0）回复(0）举报 2023-02-17

我来回答

交叉引用两个数据集以得出一个解决方案的Excel VBA函数

3条答案

相关问题

热门标签

最新问答