怎样转换等号右边的数据

CAONI

1、单元格a5开始的a列各单元格中填有不同数字，等号右边的数据为：相邻二个数字间空一格，其数值表示在h5列各小组编号。
2、单元格h5开始的h列各单元格中填有不同数字且每6行为一组h5:h10、h11:h16、h17:h22，每小组单元格从上到下依次为编号1、2、3、4、5、6并与a5列数据相对应。
3、将a5列等号右边数据编号逐个换成h5列各小组单元格中的数据且相邻二个数字间空一格，填充在n5开始的n列中。
4、具体换法是：a5列等号右边的数据（等号左边不变）先转换第1组h5:h10中的数据再换成h11:h16中的数据次换成h17:h22中的数据，依次替换.....结果依次填充在n5开始的n列中。

谢谢！

a数据替换.rar (10.34 KB, 下载次数: 13)

2024-2-7 17:56 上传

点击文件名下载附件

gwjkkkkk

Option Explicit
Sub TEST1()
    Dim ar, br(), i&, j&, k&, r&, strJoin$
   
    With [H5].CurrentRegion
        ar = .Value
        For i = 1 To UBound(ar) Step 6
            r = r + 1
            ReDim Preserve br(1 To r)
            br(r) = .Cells(i, 1).Resize(6).Value
        Next i
    End With
    ReDim ar(1 To UBound(br) * 3, 0)
    r = 0
    For i = 1 To UBound(br)
        For j = 1 To 2
            strJoin = ""
            For k = j To UBound(br(i)) Step 2
                strJoin = strJoin & " " & br(i)(k, 1)
            Next k
            r = r + 1
            ar(r, 0) = j + 2 & " =" & strJoin
        Next j
        r = r + 1
        ar(r, 0) = "5= " & br(i)(1, 1) & " " & br(i)(4, 1) & " " & br(i)(5, 1)
    Next i
   
    [O5].Resize(UBound(ar)) = ar
    Beep
End Sub

gwjkkkkk

请参考 。。。。

CAONI

gwjkkkkk 发表于 2024-2-7 19:16
请参考 。。。。

老师你好，测试了一下程序，a5列的数据好像被锁定为3行了，实际上a5列的数据不一定是3行，希望改成
arr = Range("a5:a" & Range("a1048576").End(xlUp).Row)就好了，谢谢！

gwjkkkkk

CAONI 发表于 2024-2-7 21:04
老师你好，测试了一下程序，a5列的数据好像被锁定为3行了，实际上a5列的数据不一定是3行，希望改成
arr  ...

看懂你就理解了。。。

CAONI

gwjkkkkk 发表于 2024-2-7 19:11
Option Explicit
Sub TEST1()
    Dim ar, br(), i&, j&, k&, r&, strJoin$

老师你好，测试了一下程序，本程序好似与a5列的数据无关，不管a5列的数据如何，程序结果都是：
3 = 1 3 5
4 = 2 4 6
5= 1 4 5
3 = 7 9 11
4 = 8 10 12
5= 7 10 11
3 = 13 15 17
4 = 14 16 18
5= 13 16 17


结果被锁定了......h5每小组单元格从上到下依次为编号1、2、3、4、5、6与a5列数据编号相对应。

gwjkkkkk

Option Explicit
Sub TEST1()
    Dim ar, br(), i&, j&, k&, r&, strJoin$
   
    With [H5].CurrentRegion
        ar = .Value
        For i = 1 To UBound(ar) Step 6
            r = r + 1
            ReDim Preserve br(1 To r)
            br(r) = .Cells(i, 1).Resize(6).Value
        Next i
    End With
    ReDim ar(1 To UBound(br) * 3, 0)
    r = 0
    For i = 1 To UBound(br)
        For j = 1 To 2
            strJoin = ""
            For k = j To UBound(br(i)) Step 2
                strJoin = strJoin & " " & br(i)(k, 1)
            Next k
            r = r + 1
            ar(r, 0) = r & " =" & strJoin
        Next j
        r = r + 1
        ar(r, 0) = r & "= " & br(i)(1, 1) & " " & br(i)(4, 1) & " " & br(i)(5, 1)
    Next i
   
    [O5].Resize(UBound(ar)) = ar
    Beep
End Sub

gwjkkkkk

请参考附件。。。

zxsea_7426

好久没有凑热闹了，过年凑一下热闹

CAONI

zxsea_7426 发表于 2024-2-8 19:34
好久没有凑热闹了，过年凑一下热闹

老师你好，程序经测试其结果正确，谢谢！