请老师给看看如何依据B列值将后面的数据填充,谢谢

zshyaw

请老师看看我照着例子做了一次,修改了一下,数据源的字段位置,不知道什么原因,不能填充数据,请再给看看,谢谢

zshyaw

liujing_hotwind 发表于 2023-5-5 16:01
Sub 匹配()
    arr = Sheets(1).[a6].CurrentRegion
    brr = Sheets(2).[a1].CurrentRegion

liujing_hotwind老师按照您的代码,新做另一个,不成功您给看看,谢谢

gwjkkkkk

参与一下。。。

chxw68

1. Sub test()
   
2.     Dim r%, i%
   
3.     Dim arr, brr
   
4.     Dim d As Object
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     With Worksheets("sheet2")
   
7.         r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
8.         arr = .Range("a2:e" & r)
   
9.         For i = 1 To UBound(arr)
   
10.             d(arr(i, 1)) = i
    
11.         Next
    
12.     End With
    
13.     With Worksheets("出库单")
    
14.         r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
15.         brr = .Range("a7:f" & r)
    
16.         For i = 1 To UBound(brr)
    
17.             If d.exists(brr(i, 1)) Then
    
18.                 m = d(brr(i, 1))
    
19.                 For j = 2 To 5
    
20.                     brr(i, j) = arr(m, j)
    
21.                 Next
    
22.             End If
    
23.         Next
    
24.         .Range("a7:f" & r) = brr
    
25.     End With
    
26. End Sub
    

复制代码

chxw68

重新写了一段。

zshyaw

chxw68 发表于 2023-5-5 20:31
重新写了一段。

chxw68老师谢谢您的帮助!

niko88819

gwjkkkkk 发表于 2023-5-5 18:54
参与一下。。。

gwjkkkkk  老师代码可以贴出来分享吗?

全英文系统 OFFICE+WINDOWS 代码中只要有一个中文字,打开附件,都清空,造成代码遗失了

gwjkkkkk

niko88819 发表于 2023-5-6 10:48
gwjkkkkk  老师代码可以贴出来分享吗?

全英文系统 OFFICE+WINDOWS 代码中只要有一个中文字,打开附件, ...

上班中，没办法操作，回家贴出来。。。

gwjkkkkk

niko88819 发表于 2023-5-6 10:48
gwjkkkkk  老师代码可以贴出来分享吗?

全英文系统 OFFICE+WINDOWS 代码中只要有一个中文字,打开附件, ...

Option Explicit
Sub TEST()
    Dim ar, br, cr, i&, j&, k&
   
    Application.ScreenUpdating = False
    With Sheets(1).[A6].CurrentRegion
        .Offset(1, 2).ClearContents
         ar = .Value
    End With
    br = Sheets(2).[A1].CurrentRegion
    cr = Array(1, 3, 4, 5)
    For i = 2 To UBound(ar)
        For j = 2 To UBound(br)
            If br(j, 2) = ar(i, 2) Then
                 For k = 0 To UBound(cr)
                     ar(i, k + 3) = br(j, cr(k))
                 Next k
                 Exit For
            End If
        Next j
    Next i
   
    Sheets(1).[A6].CurrentRegion = ar
    Application.ScreenUpdating = True
    Beep
End Sub