提取

ddz79101

老师！有2张表，需根据发票号，提取另一张表中数据，但因源表的数据列间隔无规则。请老师帮忙看看。

swl4561255

参见附件。

1. =IFERROR(LOOKUP(,-FIND(B2,sheet1!D$2:D$4),sheet1!A$2:A$4),"")

复制代码

ddz79101

swl4561255 发表于 2024-3-31 18:15
参见附件。

谢谢老师！能再用代码写个，便于对照

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.3.31
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     With Sheets("Sheet1")
   
4.         r = .Cells(Rows.Count, 1).End(3).Row
   
5.         c = .UsedRange.Columns.Count
   
6.         arr = .[a1].Resize(r, c)
   
7.         n = Application.WorksheetFunction.Match("年", .Rows(1), 0)
   
8.         zy = Application.WorksheetFunction.Match("摘要", .Rows(1), 0)
   
9.         je = Application.WorksheetFunction.Match("金额", .Rows(1), 0)
   
10.         fp = Application.WorksheetFunction.Match("发票号", .Rows(1), 0)
    
11.     End With
    
12.     For i = 2 To UBound(arr)
    
13.         s = CStr(arr(i, fp))
    
14.         d(s) = Array(arr(i, n), arr(i, zy), arr(i, je))
    
15.     Next
    
16.     On Error Resume Next
    
17.     With Sheets("Sheet2")
    
18.         r = .Cells(Rows.Count, 2).End(3).Row
    
19.         arr = .[a1].Resize(r, 5)
    
20.         For i = 2 To UBound(arr)
    
21.             s = CStr(arr(i, 2))
    
22.             For j = 3 To UBound(arr, 2)
    
23.                 arr(i, j) = d(s)(j - 3)
    
24.             Next
    
25.         Next
    
26.         .[a1].Resize(r, 5) = arr
    
27.         .Cells(r + 1, 4) = "合计"
    
28.         .Cells(r + 1, 5).FormulaR1C1 = "=SUM(R2C:R" & "[-1]C)"
    
29.     End With
    
30.     Set d = Nothing
    
31.     MsgBox "OK！"
    
32. End Sub
    
33. 
    

复制代码

swl4561255

1. Sub 提取1列()
   
2. arr = Array(1, 4, 10)
   
3. ar = Sheets("sheet1").[A1].End(4).Row
   
4. br = Sheets("sheet2").[B1].End(4).Row
   
5. For i = 2 To br
   
6.      For j = 2 To ar
   
7.         If InStr(Sheets("sheet1").Cells(j, 4), Sheets("sheet2").Cells(i, 2)) Then
   
8.            For k = 0 To 2
   
9.               Sheets("sheet2").Cells(i, k + 3) = Sheets("sheet1").Cells(j, arr(k))
   
10.            Next
    
11.         End If
    
12.     Next
    
13.     s = s + Cells(i, 5)
    
14. Next
    
15. Sheets("sheet2").[D65536].End(3).Offset(0, 1) = s
    
16. End Sub

复制代码

ykcbf1100

用字典固定行号列号方法也可以。

ykcbf1100

提取方法2

1. Sub ykcbf()  '//2024.3.31
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     With Sheets("Sheet1")
   
4.         r = .Cells(Rows.Count, 1).End(3).Row
   
5.         c = .UsedRange.Columns.Count
   
6.         arr = .[a1].Resize(r, c)
   
7.     End With
   
8.     For i = 2 To UBound(arr)
   
9.         s = CStr(arr(i, 7))
   
10.         d(s) = i
    
11.     Next
    
12.     For j = 1 To UBound(arr, 2)
    
13.         s = arr(1, j)
    
14.         d(s) = j
    
15.     Next
    
16.     On Error Resume Next
    
17.     With Sheets("Sheet2")
    
18.         r = .Cells(Rows.Count, 2).End(3).Row
    
19.         brr = .[a1].Resize(r, 5)
    
20.         For i = 2 To UBound(brr)
    
21.             s = CStr(brr(i, 2))
    
22.             For j = 3 To UBound(brr, 2)
    
23.                 ss = brr(1, j)
    
24.                 brr(i, j) = arr(d(s), d(ss))
    
25.             Next
    
26.         Next
    
27.         .[a1].Resize(r, 5) = brr
    
28.         .Cells(r + 1, 4) = "合计"
    
29.         .Cells(r + 1, 5).FormulaR1C1 = "=SUM(R2C:R" & "[-1]C)"
    
30.     End With
    
31.     Set d = Nothing
    
32.     MsgBox "OK！"
    
33. End Sub
    

复制代码

shiruiqiang

sql语句练练手

ddz79101

ykcbf1100 发表于 2024-3-31 18:46
附件供参考。。。

谢谢老师！正确结果