VBA 配对 ( 有难度 )

On_fire

VBA 配对 ( 有难度 )

*

Sheet1, A是标题列, B列单元格 ( 子 )往右, 如不为空, 需要” 添加前缀 及 点号 “

#

Sheet2, A列是父, B列往右的下一行是 ( 子 )

*

代码的逻辑如下,

1.      Sheet2, B列往右的单元格是唯一值 ( 单元格内的字符串是唯一值 )

2.      Sheet2, A列是父, B列往右的下一行是 ( 子 ), 父子是对应的

*

3.      Sheet1的B列往右单元格内, 唯一值, 有可能添加不同后缀 ( 如:符号, 数字 )

4.      Sheet1的B列往右单元格内, 利用唯一值的关连, 添加” 前缀( 父 ) 及 点号 ( . ) “

*

如何用正值表达式, 完成?

模拟结果在Sheet1(2)日

*

这题难度高!

恳请大神, 老师帮忙…谢谢!

ykcbf1100

你是天天出难题啊

liulang0808

这个是what需求？

liulang0808

需求描述太难，猜了一下

gwjkkkkk

理解题目比写代码还难。。。

On_fire

liulang0808 发表于 2023-3-27 13:13
需求描述太难，猜了一下

刚出差回来,
谢谢版主, 但只解了一半题…

On_fire

ykcbf1100 发表于 2023-3-27 12:52
你是天天出难题啊

刚出差回来,
谢谢老师关注, 这题有点绕…

On_fire

gwjkkkkk 发表于 2023-3-27 22:48
理解题目比写代码还难。。。

刚出差回来,
谢谢老师关注, 这题有点绕…
*
Sheet2的[ G22 ]单元格内字符串, 是(一二), 对应上一行A列的(三)
(图1)
Sheet1的[ F23 ]单元格内字符串, 是(一二2)
(图2)
*
正值的代码配对逻辑是成功, 因为(一二)是相同的,
*
所以Sheet1的[ F23 ]单元格内字符串, 由原来的(一二2), 更新为(三. 一二2 )
(图3)

liulang0808

On_fire 发表于 2023-3-30 15:31
刚出差回来,
谢谢老师关注, 这题有点绕…
*

再增加一个字典同类计数看看吧

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 = .UsedRange.Find(what:="*", LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious).Row
   
8.         c = .UsedRange.Find(what:="*", LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
   
9.         arr = .Range("a1").Resize(r, c)
   
10.         For i = 2 To UBound(arr)
    
11.             If Len(arr(i, 1)) <> 0 Then
    
12.                 For j = 2 To UBound(arr, 2)
    
13.                     If Len(arr(i + 1, j)) <> 0 Then
    
14.                         d(CStr(arr(i + 1, j))) = arr(i, 1)
    
15.                     End If
    
16.                 Next
    
17.             End If
    
18.         Next
    
19.     End With
    
20.     With Worksheets("sheet1")
    
21.         r = .UsedRange.Find(what:="*", LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious).Row
    
22.         c = .UsedRange.Find(what:="*", LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
    
23.         arr = .Range("a1").Resize(r, c)
    
24.         For i = 2 To UBound(arr)
    
25.             For j = 2 To UBound(arr, 2)
    
26.                 If Len(arr(i, j)) <> 0 Then
    
27.                     xm = Split(arr(i, j), Space(1))
    
28.                     If d.exists(xm(0)) Then
    
29.                         arr(i, j) = d(xm(0)) & "." & arr(i, j)
    
30.                     End If
    
31.                 End If
    
32.             Next
    
33.         Next
    
34.         .Range("a1").Resize(r, c) = arr
    
35.     End With
    
36. End Sub
    

复制代码