[已解决]公式求助

chen418102

各位大神，怎样将不同个数的尺码用&相联系起来，谢谢！

最佳答案

月排行榜 / 总排行榜

望帝春心

2016-12-19 15:10

VBA

1. Sub test()
   
2.     Dim i&, j&
   
3.     Application.ScreenUpdating = False
   
4.     Cells(1, 2).End(4).Offset(1, -1) = "*"
   
5.     For i = 2 To Cells(1, 2).End(4).Row
   
6.         For j = i + 1 To Cells(1, 2).End(4).Row + 1
   
7.             If Cells(i, 1) <> "" And Len(Cells(j, 1)) > 0 Then
   
8.                 arr = Cells(i, 2).Resize(j - i, 1)
   
9.                 s = Join(Application.Transpose(arr), "/")
   
10.                 Cells(i, 3) = s
    
11.                 s = ""
    
12.                 Exit For
    
13.             End If
    
14.         Next
    
15.      Next
    
16.    Cells(1, 2).End(4).Offset(1, -1).Clear
    
17.    Application.ScreenUpdating = True
    
18. End Sub

复制代码

跳转到最佳答案楼层

望帝春心

用公式好像要用辅助列才行，最新版的TEXTJOIN函数不知道可不可以做

chen418102

望帝春心 发表于 2016-12-19 08:59
用公式好像要用辅助列才行，最新版的TEXTJOIN函数不知道可不可以做

非常感谢回复，我EXCEL是07版，用不了TEXTJOIN，辅助栏也不易加啊

望帝春心

chen418102 发表于 2016-12-19 09:57
非常感谢回复，我EXCEL是07版，用不了TEXTJOIN，辅助栏也不易加啊

综上所述，这个问题适合用VBA解决

砂海

C列 全部写上 /
因 PHONETIC 只支持 常量文本,还不能是文本型数字

=IF(A2<>"",LEFT(PHONETIC(OFFSET(B2,,,MIN(IF(A3:A23="",65536,ROW(A3:A23)))-ROW(),2)),LEN(PHONETIC(OFFSET(B2,,,MIN(IF(A3:A23="",65536,ROW(A3:A23)))-ROW(),2)))-1),"")
数组公式 Ctrl + Shift +Enter

同意4楼 , 不用辅助单元格 就Vba 了
--------------------------------------
以下无实用价值笨方法 , 只是提供一种可能性
硬不用 辅助列 就要手工
用rept()补足长度,
=B2&REPT(" ",MAX(0,3-LEN(B2)))&"/"
联接单元格 , 个数>=最多值
形成 "70B/M  /......."
再去截取以后 , 去除" "

望帝春心

VBA

1. Sub test()
   
2.     Dim i&, j&
   
3.     Application.ScreenUpdating = False
   
4.     Cells(1, 2).End(4).Offset(1, -1) = "*"
   
5.     For i = 2 To Cells(1, 2).End(4).Row
   
6.         For j = i + 1 To Cells(1, 2).End(4).Row + 1
   
7.             If Cells(i, 1) <> "" And Len(Cells(j, 1)) > 0 Then
   
8.                 arr = Cells(i, 2).Resize(j - i, 1)
   
9.                 s = Join(Application.Transpose(arr), "/")
   
10.                 Cells(i, 3) = s
    
11.                 s = ""
    
12.                 Exit For
    
13.             End If
    
14.         Next
    
15.      Next
    
16.    Cells(1, 2).End(4).Offset(1, -1).Clear
    
17.    Application.ScreenUpdating = True
    
18. End Sub

复制代码