数据多对多匹配！

lizequn1976

求助：将sheet2中各城市对应的数值填写到本表中，如果数值不够用，则为空。简单的模拟数据，主要是完成多对多如何匹配。

taller

z865593849

多对多匹配

quqiyuan

参与一下，使用双字典，仅供参考。。。

quqiyuan

代码如下。。。
Sub test()
    Dim wb As Workbook, sht As Worksheet, sh As Worksheet
    Set wb = ThisWorkbook
    Set sht = wb.Sheets("sheet1")
    Set sh = wb.Sheets("sheet2")
    arr = sht.[a1].CurrentRegion
    brr = sh.[a1].CurrentRegion
    Set d = CreateObject("scripting.dictionary")
    For i = 2 To UBound(arr)
        s = arr(i, 1)
        If Not d.exists(s) Then Set d(s) = CreateObject("scripting.dictionary")
        d(s)(i) = d(s).Count + 1
    Next
    Set d1 = CreateObject("scripting.dictionary")
    For i = 2 To UBound(brr)
        s = brr(i, 1)
        If Not d1.exists(s) Then Set d1(s) = CreateObject("scripting.dictionary")
        d1(s)(i) = d1(s).Count + 1
    Next
    For i = 2 To UBound(arr)
        s = arr(i, 1)
        x = Application.Match(d(s)(i), d1(s).Items, 0)
        If IsNumeric(x) Then
            Key = d1(s).keys
            arr(i, 2) = brr(Key(x - 1), 2)
        End If
    Next
    sht.[d1].Resize(UBound(arr), UBound(arr, 2)) = arr
    Set d = Nothing
    Set d1 = Nothing
    Beep
End Sub

ericxzhou

Python+Pandas:
import pandas as pd

f = pd.ExcelFile('pandas exercise/sample547.xlsx')
df = f.parse('Sheet1', usecols='a', index_col=0)
df1 = f.parse('Sheet2', index_col=0)

df['sn'] = df.groupby('地点').cumcount()
df = df.set_index('sn', append=True)
df1['sn'] = df1.groupby('地点').cumcount()
df1 = df1.set_index('sn', append=True)

df.join(df1).reset_index().drop('sn', axis=1).fillna('')

xlj310

Sub 测试2() '双字典法，一个记录个数，一个记录值，简简单单，相当于vlookup
    Sheet2Arr = Sheet2.[a1].CurrentRegion
    Sheet1Arr = Sheet1.[a1].CurrentRegion
    Set Dic计数1 = CreateObject("scripting.dictionary")
    Set Dic计数2 = CreateObject("scripting.dictionary")
    Set Dic数值 = CreateObject("scripting.dictionary")
    For 行 = 2 To UBound(Sheet2Arr)
        Key = Sheet2Arr(行, 1)
        Dic计数1(Key) = Dic计数1(Key) + 1 '累计
        Dic数值(Key & Dic计数1(Key)) = Sheet2Arr(行, 2) '记录值
    Next
    For 行 = 2 To UBound(Sheet1Arr)
        Key = Sheet1Arr(行, 1)
        Dic计数2(Key) = Dic计数2(Key) + 1 '累计
        Sheet1Arr(行, 2) = Dic数值(Key & Dic计数2(Key))
    Next
    Sheet1.[b1].Resize(UBound(Sheet1Arr), 1).Value = Application.WorksheetFunction.Index(Sheet1Arr, 0, 2)
End Sub

多对多字典练习.zip (17.49 KB, 下载次数: 7)

2024-11-2 10:24 上传

点击文件名下载附件

quqiyuan

供你参考。。。

quqiyuan

代码如下。。。
Sub test()
    Dim wb As Workbook, sht As Worksheet, sh As Worksheet
    Set wb = ThisWorkbook
    Set sht = wb.Sheets("sheet1")
    Set sh = wb.Sheets("sheet2")
    arr = sht.[a1].CurrentRegion
    brr = sh.[a1].CurrentRegion
    Set d = CreateObject("scripting.dictionary")
    For i = 2 To UBound(arr)
        s = arr(i, 1)
        If Not d.exists(s) Then Set d(s) = CreateObject("scripting.dictionary")
        d(s)(i) = d(s).Count + 1
    Next
    Set d1 = CreateObject("scripting.dictionary")
    For i = 2 To UBound(brr)
        s = brr(i, 1)
        If Not d1.exists(s) Then Set d1(s) = CreateObject("scripting.dictionary")
        d1(s)(i) = d1(s).Count + 1
    Next
    For i = 2 To UBound(arr)
        s = arr(i, 1)
        If d1.exists(s) Then
            x = Application.Match(d(s)(i), d1(s).Items, 0)
            If IsNumeric(x) Then
                Key = d1(s).keys
                arr(i, 2) = brr(Key(x - 1), 2)
                '            arr(i, 2) = brr(d1(s).keys(x - 1), 2)
            End If
        End If
    Next
    sht.[d1].Resize(UBound(arr), UBound(arr, 2)) = arr
    Set d = Nothing
    Set d1 = Nothing
    Beep
End Sub

ynzsvt

单字典加数组单链，多对多顺序输出。