前面数字，对应填到后面

翁知江安

Sub test()
Dim i, j, k, m, n As Integer
Dim ar, br, cr As Variant
Dim d As Object
Set d = CreateObject("scripting.dictionary")
ar = Sheets(1).Range("a1:g" & Sheets(1).[a65536].End(xlUp).Row)
ReDim br(1 To UBound(ar), 1 To 33)
ReDim cr(1 To UBound(ar), 1 To 16)
If UBound(ar) >= 2 Then
For i = 2 To UBound(ar)
    For j = 1 To UBound(ar, 2) - 1
    If ar(i, j) <= 33 And ar(i, j) >= 1 Then
    If Not d.exists(ar(i, j)) Then
    br(i - 1, ar(i, j)) = ar(i, j)
    d(ar(i, j)) = i - 1
    Else
       br(d(ar(i, j)), ar(i, j)) = br(d(ar(i, j)), ar(i, j)) & "," & ar(i, j)
    End If
    End If
    Next
    If ar(i, UBound(ar, 2)) <= 16 And ar(i, UBound(ar, 2)) >= 1 Then
    cr(i - 1, ar(i, UBound(ar, 2))) = ar(i, UBound(ar, 2))
    End If
Next
End If
With Sheets(1)
.[h2].Resize(100, 33).ClearContents
.[h2].Resize(UBound(br), 33) = br
.[ap2].Resize(100, 16).ClearContents
.[ap2].Resize(UBound(cr), 16) = cr
End With
MsgBox "ok"
End Sub

翁知江安

供参考，欢迎批评指正

taller

我来学习知识 发表于 2025-3-29 10:31
不用代码，不会，公式就行了，A-F列有数字几，后面的1-33下面同列就会有数字，显示的是和前面相同的就行

如果不需要代码，那么在【函数公式】 版面发帖更容易得到公式高手的帮助

凌空一羽

function lkyy()
{
        let myr=Range("a1000").End(xlUp).Row;
        for(var i=2;i<=myr;i++){
                for(var j=1;j<=6;j++){
                        let num=Cells(i,j).Value2;
                        Cells(i,num+7).Value2=num;
                }
                let nm=Cells(i,7).Value2;
                Cells(i,nm+41).Value2=nm;
        }
}