求助，VBA添加无编码的存货并自动编码

elong185

复制无编码的F列和G列，添加到Sheet2的B列和C列 并继续编码

gwjkkkkk

Option Explicit
Sub TEST1()
    Dim ar, br, i&, j&, r&, m&, n&
   
    ar = Worksheets(2).[A1].CurrentRegion.Value
   
    ReDim br(1 To UBound(ar), 1 To 3)
   
    For i = 3 To UBound(ar)
        If Len(ar(i, 5)) = 0 Then
            r = r + 1
            For j = 5 To 7
                br(r, j - 4) = ar(i, j)
            Next j
        End If
    Next i
   
    If r Then
        With Worksheets(1)
            n = .Cells(.Rows.Count, "A").End(xlUp).Row
            m = .Cells(n, 1).Value
            n = n + 1
            For i = m + 1 To m + r
                br(i - m, 1) = i
            Next i
            .Cells(n, 1).Resize(r, 3) = br
            .Activate
        End With
    End If
   
    Beep
End Sub

gwjkkkkk

。。。。。。。。。。。。

ykcbf1100

参与一下。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.8.1
   
2.     With Sheets("采购进货")
   
3.         r = .Cells(Rows.Count, 6).End(3).Row
   
4.         arr = .[e1].Resize(r, 3)
   
5.         r1 = .Cells(Rows.Count, 5).End(3).Row
   
6.         mm = Val(.Cells(r1, 5))
   
7.     End With
   
8.     ReDim brr(1 To r, 1 To 3)
   
9.     For i = 3 To UBound(arr)
   
10.         If arr(i, 1) = Empty Then
    
11.             m = m + 1
    
12.             brr(m, 1) = mm + m
    
13.             brr(m, 2) = arr(i, 2)
    
14.             brr(m, 3) = arr(i, 3)
    
15.         End If
    
16.     Next
    
17.     With Sheets("存货")
    
18.         r = .Cells(Rows.Count, 1).End(3).Row
    
19.         .Cells(r + 1, 1).Resize(m, 3) = brr
    
20.     End With
    
21.     MsgBox "OK！"
    
22. End Sub
    

复制代码

elong185

gwjkkkkk 发表于 2024-8-1 19:15
Option Explicit
Sub TEST1()
    Dim ar, br, i&, j&, r&, m&, n&

感谢！！！！