如何用字典导入表

zgzyd2020

首先多次就一个内容发贴，向大家道谦！！我是小白，我通过以下代码明白了数组法的问题：如果将源文件表的格式或内容复制致目标表，代码能成功。但因格式不一致（或前面有多几个空格），虽文本一致，却而不能导入 。我想用字典法可以导入。但论坛中无相应列子，想请名位老师做一个，万分感谢（也可能用数组法也能实现文本一致的导入）。

笨鸟飞不高

先仔细核对一下不导入项的名称一致吗？？？

约定的童话

里面空格数不一样吧

鬱彠

2.4电力、热力、燃气及水的生产和供应业
2.4电力、热力、燃气及水生产和供应业
一个比另一个长。。。。。

准提部林

Sub TEST()
Dim xR As Range, xD, X
Set xD = CreateObject("Scripting.Dictionary")
For Each xR In Range([E10], [E65536].End(xlUp))
    X = Val(Replace(Trim(xR), ".", 0))
    If Val(xR(1, 2)) > 0 And X > 0 Then xD(X) = xR(1, 2)
Next
For Each xR In Range("B8:B36")
    If xR(1, 2).HasFormula Then GoTo 101
    X = Val(Replace(Trim(xR), ".", 0))
    If xD(X) > 0 Then xR(1, 2) = xD(X) Else xR(1, 2) = ""
101: Next
End Sub

Xl0000476.rar (17.52 KB, 下载次数: 5)

2020-9-20 10:12 上传

点击文件名下载附件

只做取值示意方法, 不知合不合, 跨檔抓源表則自行處理~~

3190496160

Sub 导入()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
lj = ThisWorkbook.Path & "\"
f = Dir(lj & "源源*.xls*")
If f = "" Then MsgBox "找不到源文件！": Exit Sub
With Sheets("g01附注VII")
    ar = .Range("b10:c36")
    For i = 1 To UBound(ar)
        If Trim(ar(i, 1)) <> "" Then
            d(Trim(ar(i, 1))) = i
        End If
    Next i
    Set wb = Workbooks.Open(lj & f, 0)
    br = wb.Worksheets(1).[a1].CurrentRegion
    wb.Close False
    For i = 7 To UBound(br)
        m = d(Trim(br(i, 2)))
        If m <> "" Then
            ar(m, 2) = br(i, 3)
        End If
    Next i
     .Range("b10:c36") = ar
End With
MsgBox "ok!"
End Sub

3190496160

G01资产负债项目统计表(第VII部分).rar (32.25 KB, 下载次数: 15)

2020-9-20 11:10 上传

点击文件名下载附件

3190496160

楼主对工作的认真程度，真的值得商榷，你认真的看看，源文件和目标文件中的好几项，文本真的一致吗？
给你的文件中已经帮你修改过来了，现在都可以导入了，要用字典，必须保证目标和源一致才行，代码就是字典匹配的典型代码，自己研究研究吧

zgzyd2020

大师多谢，我如果对数组计算
是否加ows1 = ThisWorkbook.Sheets("G01附注VII").Range("c10:c36")
ReDim CRR(1 To UBound(irows1))
crr(21) = crr(21) + crr(28)
crr(28) = 0
End Sub
即：将行数28的清零，将行28的数加在21行处。
我的为何不成功。
并字典法如何只有有公式的不导入。

renkangjizhen

先学习相关基础理论，再去实践，实在不行然后再发帖求援，这才是正常的学习之道！