返回列表 上一主題 發帖

[發問] 列出更多的對應資料

刪去公式,使用VBA會更快:
  1. Sub zz()
  2. Dim a, d As Object, b(), n&
  3. a = Sheets(1).Range("a2:d" & Sheets(1).[a1048576].End(3).Row)
  4. Set d = CreateObject("scripting.dictionary")
  5. With CreateObject("vbscript.regexp")
  6.     .Pattern = "-\w$"
  7.     For i = 1 To UBound(a)
  8.         If Len(a(i, 3)) = 0 Then a(i, 3) = a(i, 1)
  9.         k = a(i, 3)
  10.         a(i, 3) = .Replace(k, "")
  11.         d(a(i, 3)) = ""
  12.     Next
  13.     k = Join(d.keys, "|")
  14.     .Pattern = k
  15.     a = Sheets(2).[a1].CurrentRegion
  16.     ReDim b(1 To UBound(a), 1 To UBound(a, 2))
  17.     For i = 2 To UBound(a)
  18.         If Len(a(i, 3)) > 0 Then k = a(i, 3) Else k = a(i, 1)
  19.         If .test(k) Then
  20.              n = n + 1
  21.              For j = 1 To UBound(a, 2)
  22.                 b(n, j) = a(i, j)
  23.              Next
  24.         End If
  25.     Next
  26.     Sheets(3).[a1].CurrentRegion.Offset(1).Clear
  27.     Sheets(3).[a2].Resize(n, 4) = b
  28. End With
  29. End Sub
複製代碼

zz.zip (18.66 KB)

TOP

回復 9# qaqa3296
  1. Sub zz()
  2. Dim a, d As Object, b, n&
  3. a = Sheets(1).Range("a2:d" & Sheets(1).[a1048576].End(3).Row)
  4. Set d = CreateObject("scripting.dictionary")
  5. With CreateObject("vbscript.regexp")
  6.     .Pattern = "[-\.\s]+"
  7.     .Global = True
  8.     For i = 1 To UBound(a)
  9.         If Len(a(i, 3)) = 0 Then a(i, 3) = Trim(a(i, 1))
  10.         a(i, 3) = Trim(a(i, 3))
  11.         k = Split(.Replace(a(i, 3), "|"), "|")
  12.         If UBound(k) > 0 Then k = k(0) & "-" & k(1) Else k = a(i, 3)
  13.         d(k) = ""
  14.     Next
  15.     k = Join(d.keys, "|")
  16.     .Pattern = k
  17.     a = Sheets(2).[a1].CurrentRegion
  18.     b = a: n = 1
  19.     For i = 2 To UBound(a)
  20.         If Len(a(i, 3)) > 0 Then k = a(i, 3) Else k = a(i, 1)
  21.         If .TEST(k) Then
  22.              n = n + 1
  23.              For j = 1 To UBound(a, 2)
  24.                 b(n, j) = a(i, j)
  25.              Next
  26.         End If
  27.     Next
  28.     Workbooks.Add 1
  29.     [a1].Resize(n, 4) = b
  30. End With
  31. End Sub
複製代碼

TOP

        靜思自在 : 天上最美是星星,人生最美是溫情。
返回列表 上一主題