数据的引用和转置

laojiu369

gwjkkkkk 发表于 2024-1-29 18:24
Option Explicit
Sub TEST6()
    Dim ar, br, cr, i&, j&, k&, r&

老师：
该要求了，还请帮忙！
3、新的要求：请修改为只显示在F2单元格，以数据+空格形式显示，不再转置为竖列逐格显示。
麻烦您费心了

清风竹-

laojiu369 发表于 2024-1-30 08:03
老师：
该要求了，还请帮忙！
3、新的要求：请修改为只显示在F2单元格，以数据+空格形式显示，不再转置 ...

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

laojiu369

感谢清风竹老师出手相助！
问题解决了，并且完全符合我的要求，非常满意！
预祝老师过年好！

准提部林

以空字符連接//放F3
Sub Test_A2() 'by.准提部林
Dim Arr, TT$, SS$, i&, j%
Arr = Range([k6], [h65536].End(3))
TT = "  " & Range("a2") & " "
For i = 1 To UBound(Arr)
    If InStr(TT, " " & Arr(i, 1) & " ") > 1 Then
       SS = SS & " " & Arr(i, 2) & " " & Arr(i, 3) & " " & Arr(i, 4)
    End If
Next i
[f3] = Mid(SS, 2)
End Sub

laojiu369

准提部林 发表于 2024-1-31 12:05
以空字符連接//放F3
Sub Test_A2() 'by.准提部林
Dim Arr, TT$, SS$, i&, j%

老师好：
你写程序我试过了，只是把F3改成了F2，完全符合我的要求。
感谢您了！祝过年好！

laojiu369

终于明白了，加分就是送花，太菜了，哈哈哈哈。
今后还是要多学习。

gwjkkkkk

laojiu369 发表于 2024-1-30 08:03
老师：
该要求了，还请帮忙！
3、新的要求：请修改为只显示在F2单元格，以数据+空格形式显示，不再转置 ...

Option Explicit
Sub TEST6()
    Dim ar, br, cr, i&, j&, k&, r&
   
    Application.ScreenUpdating = False

    With Range("H6", Cells(Rows.Count, "K").End(xlUp))
        ar = .Columns("A:B")
        For i = 1 To UBound(ar)
            ar(i, 2) = .Rows(i)
        Next i
    End With
    br = Split([A2].Value)
    ReDim cr(1 To (UBound(br) + 1) * (UBound(ar) - 1))
    For j = 0 To UBound(br)
        For i = 1 To UBound(ar)
            If ar(i, 1) = br(j) Then
                For k = 2 To UBound(ar(i, 2), 2)
                    r = r + 1
                    cr(r) = ar(i, 2)(1, k)
                Next k
                Exit For
            End If
        Next i
    Next j
   
   
    [F2].Value = Join(cr)
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

请参考。。。

laojiu369

gwjkkkkk 发表于 2024-2-3 11:49
请参考。。。

老师好：
首先感谢出手帮助，试过了很好！
春节马上就要到了，祝您春节愉快！