实在受不了这个速度了！查找并选中指定字符单元格！

wfchenyiting

yjh_27 发表于 2019-1-20 14:25
减少合并次数  提速

老师非常感谢您的代码，学习了。请教如何合并减少合并次数啊？谢谢

今天小花送完了，来日补上，不胜感激！

wfchenyiting

不知道为什么 发表于 2019-1-20 13:40
代码供参考

谢谢老师的代码，刚测试了，确实速度显著提升，我的电脑几次测试都在2.6秒左右，比我之前的快的太多了。

感谢感谢。今天小花用完了，来日补上！

wfchenyiting

huanghai22 发表于 2019-1-20 14:31
这个速度不知道满不满意？

很惊喜！大神代码我还没能完全理解，还在学习。刚抄写下来测试了，速度在2.9秒左右，已经很棒了！小遗憾是最下面一部分的符合的单元格并没有选中。我看自己能否完善下，您的代码思路值得大家学习。非常感谢

今日小花用完，来日补上，略表谢意！

wfchenyiting

想不到自己一个小小的需求，得到论坛诸多老师们的关注和支持！心理非常感动，感谢各位老师的代码和思路。通过对上面各位老师代码自己测试，现在基本能做到最快的速度， 已经到3秒内了。这么多老师的回帖让我这样小白除了学习代码外，更加感受了论坛老师们的 智慧、热心、共享的精神，再次感谢各位！
今日小花用完了，对各位老师的帮助无法表谢，来日一一补上！thanks！

再次期待能有更多的老师提供解决思路，期待学习！

一把小刀闯天下

yjh_27 发表于 2019-1-20 14:25
减少合并次数  提速

'学习一下，请问大神怎么才能合并次数，，，

Option Explicit

Sub test()
  Dim i, j, rng As Range, m, n, arr, t, s As String
  t = Timer
  arr = [a1].CurrentRegion
  ReDim brr(1 To UBound(arr, 1) * UBound(arr, 2) / 42, 1 To 1) As String
  For i = 2 To UBound(arr, 1)
    For j = 1 To UBound(arr, 2)
      If InStr(arr(i, j), "昆山") > 0 Then
        m = m + 1
        s = s & "," & Cells(i, j).Address(0, 0)
        If m Mod 42 = 0 Then
          n = n + 1: brr(n, 1) = Mid(s, 2)
          s = vbNullString
        End If
      End If
  Next j, i
  If m = 0 Then Exit Sub
  If Len(s) Then n = n + 1: brr(n, 1) = Mid(s, 2)
  Set rng = Range(brr(1, 1))
  For i = 2 To n
    Set rng = Union(rng, Range(brr(i, 1)))
  Next
  rng.Select
  Debug.Print m, Format(Timer - t, "0.00s")
End Sub

chis3

wfchenyiting 发表于 2019-1-20 16:37
想不到自己一个小小的需求，得到论坛诸多老师们的关注和支持！心理非常感动，感谢各位老师的代码和思路。通 ...

因為這個特別啊,一般都是運算什麼的,速度沒問題
但這個要不停連接對像的,真的想知道怎可加快速度

张道贤

条条大路通罗马，每个人的思路不一样。方法很多……

yjh_27

wfchenyiting 发表于 2019-1-20 16:22
老师非常感谢您的代码，学习了。请教如何合并减少合并次数啊？谢谢

今天小花送完了，来日补上，不胜感 ...

代码在37L啊

micch

学习了，不过为什么我写代码的时候range最多只能33个单元格地址，再多就提示方法range对象错误了

yjh_27

micch 发表于 2019-1-20 18:43
学习了，不过为什么我写代码的时候range最多只能33个单元格地址，再多就提示方法range对象错误了

用相对地址，字符少。
限制长度255