Excel精英培训网

 找回密码
 注册

QQ登录

只需一步,快速开始

工作中常用的Excel函数公式,全印在一张超大鼠标垫上
查看: 94|回复: 7

[已解决]没有相同字母才合并,100*100*100*100,公式太多,求来一VB码

[复制链接]
发表于 2021-11-23 18:18 | 显示全部楼层 |阅读模式
360截图20211123180056558.jpg
D4=B4合并D2,
E5=B5合并E2,
...等等。也就是,B6合并F2, 这两个单元格同时都有值(文本),有对应才合并。
合并条件没有相同字母才合并,(2ABJ)(2CDK)  这样才可以。
不能出现两个字母相同。
满足合并条件才显示,否为空。
B4-B列未知
D3-横向未知
输出:D4=($B4&D$2)没有相同字母才合并,否为空
100*100*100*100,公式太多,求来一VB码

最佳答案
2021-11-23 20:01
  1. Sub test()
  2. Dim arr1, arr2, arrRst$(), i&, j&, k&, b As Boolean, sTmp$
  3. arr1 = Range("b4:b" & Cells(Rows.Count, 2).End(3).Row)
  4. arr2 = [d2].Resize(, Cells(2, Columns.Count).End(1).Column - 3)
  5. ReDim arrRst(1 To UBound(arr1), 1 To UBound(arr2, 2))
  6. For i = 1 To UBound(arr1)
  7.   For j = 1 To UBound(arr2, 2)
  8.     b = False
  9.     For k = 2 To Len(arr1(i, 1)) - 1
  10.       sTmp = Mid(arr1(i, 1), k, 1)
  11.       If Not IsNumeric(sTmp) Then If InStr(arr2(1, j), Mid(arr1(i, 1), k, 1)) Then b = True: Exit For
  12.     Next
  13.     If b = False Then arrRst(i, j) = arr1(i, 1) & arr2(1, j)
  14.   Next j
  15. Next i
  16. [d4].Resize(UBound(arrRst), UBound(arrRst, 2)) = arrRst
  17. End Sub
复制代码
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2021-11-23 20:01 | 显示全部楼层    本楼为最佳答案   
  1. Sub test()
  2. Dim arr1, arr2, arrRst$(), i&, j&, k&, b As Boolean, sTmp$
  3. arr1 = Range("b4:b" & Cells(Rows.Count, 2).End(3).Row)
  4. arr2 = [d2].Resize(, Cells(2, Columns.Count).End(1).Column - 3)
  5. ReDim arrRst(1 To UBound(arr1), 1 To UBound(arr2, 2))
  6. For i = 1 To UBound(arr1)
  7.   For j = 1 To UBound(arr2, 2)
  8.     b = False
  9.     For k = 2 To Len(arr1(i, 1)) - 1
  10.       sTmp = Mid(arr1(i, 1), k, 1)
  11.       If Not IsNumeric(sTmp) Then If InStr(arr2(1, j), Mid(arr1(i, 1), k, 1)) Then b = True: Exit For
  12.     Next
  13.     If b = False Then arrRst(i, j) = arr1(i, 1) & arr2(1, j)
  14.   Next j
  15. Next i
  16. [d4].Resize(UBound(arrRst), UBound(arrRst, 2)) = arrRst
  17. End Sub
复制代码
回复

使用道具 举报

发表于 2021-11-23 20:09 | 显示全部楼层
回复

使用道具 举报

发表于 2021-11-23 20:10 | 显示全部楼层
心正意诚身修 发表于 2021-11-23 20:09
妈呀。附件都没有你就整出来了。

有附件的,在另外一个论坛上
回复

使用道具 举报

 楼主| 发表于 2021-11-23 20:11 | 显示全部楼层
回复

使用道具 举报

发表于 2021-11-23 20:12 | 显示全部楼层
If Not IsNumeric(sTmp) Then If InStr(arr2(1, j), Mid(arr1(i, 1), k, 1)) Then b = True: Exit For
这句后面忘记修改成sTmp了,不过不影响使用。
If Not IsNumeric(sTmp) Then If InStr(arr2(1, j), sTmp) Then b = True: Exit For
回复

使用道具 举报

 楼主| 发表于 2021-11-23 20:15 | 显示全部楼层
大灰狼1976 发表于 2021-11-23 20:12
If Not IsNumeric(sTmp) Then If InStr(arr2(1, j), Mid(arr1(i, 1), k, 1)) Then b = True: Exit For
这 ...

知道了 ,谢谢哈
回复

使用道具 举报

发表于 2021-11-23 20:18 | 显示全部楼层
love586 发表于 2021-11-23 20:15
知道了 ,谢谢哈

不必客气哈
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2021-11-27 19:43 , Processed in 0.177995 second(s), 7 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表