很难！！！VBA数据多条件排序之二，这个比前一个更难，请请路过大侠指点！！！

xiaofan1999

很难！！！VBA数据多条件排序之二，这个比前一个更难，请请路过大侠指点！！！



如果太难，能够完成条件2区域     >1     的(指大于同行左面的第一个数值）这一个条件也行。请路过大侠指点！！！

xiaofan1999

如果太难，能够完成条件2区域     >1     的(指大于同行左面的第一个数值）这一个条件也行。请路过大侠指点！！！

一把小刀闯天下

'"暨巧夏"不符合要求，符合要求的只有2行

Option Explicit

Sub test()
  Dim arr, brr, i, j, k, n, t
  arr = [a11:ae29]: brr = arr
  For i = 4 To UBound(arr, 1)
    For j = 2 To UBound(arr, 2)
      If Len(arr(1, j)) > 0 Then
        If Not Evaluate(arr(i, j) & arr(1, j)) Then Exit For
      End If
    Next
    If j = UBound(arr, 2) + 1 Then
      For j = 2 To UBound(arr, 2)
        If Len(arr(2, j)) > 0 Then
          For k = Len(arr(2, j)) To 1 Step -1
            If Not IsNumeric(Mid(arr(2, j), k, 1)) Then
              t = Right(arr(2, j), Len(arr(2, j)) - k)
              Exit For
            End If
          Next
          If j - Val(t) > 1 Then
            t = Replace(arr(2, j), t, Space(1)) & arr(i, j - Val(t))
            If Not Evaluate(arr(i, j) & t) Then Exit For
          End If
        End If
      Next
      If j = UBound(arr, 2) + 1 Then
        n = n + 1
        For j = 1 To UBound(arr, 2)
          brr(n, j) = arr(i, j)
        Next
      End If
    End If
  Next
  With [a37]
    .Resize(Rows.Count - 36, UBound(brr, 2)).ClearContents
    If n > 0 Then .Resize(n, UBound(brr, 2)) = brr
  End With
End Sub

xiaofan1999

一把小刀闯天下 发表于 2018-5-25 14:09
'"暨巧夏"不符合要求，符合要求的只有2行

Option Explicit

谢谢大侠！！！小弟对您五体投地！！！

xiaofan1999

xiaofan1999 发表于 2018-5-25 15:32
谢谢大侠！！！小弟对您五体投地！！！

谢谢大侠！！！小弟对您五体投地！！！