提取

霜雪GILL

当M例中的值等于AC1的值,提取左边5例数值到AC2 ,谢谢!

liulang0808

Sub 按钮1_Click()
    Application.ScreenUpdating = False
    Application.Intersect(Columns("ac:ac"), ActiveSheet.UsedRange).Offset(1).ClearContents
    For j = 2 To Cells(Rows.Count, "m").End(3).Row
        If Cells(j, "m") = [ac1] Then
            Cells(j, "h").Resize(1, 5).Copy Cells(Rows.Count, "ac").End(3).Offset(1)
        End If
    Next j
    Application.ScreenUpdating = True
End Sub

liulang0808

附件内容供参考。。。。。。

霜雪GILL

liulang0808 发表于 2019-10-6 15:19
附件内容供参考。。。。。。

麻烦再帮我改改代码,万分感激!
当M例中的值等于AC1的值,提取所对应的值左边5例数值到AC2 ,谢谢
当S例中的值等于AD1的值,提取所对应的值左边5例数值到AH2 ,谢谢
如此类推，AC1到AV1 共有21个数值

一把小刀闯天下

霜雪GILL 发表于 2019-10-12 22:26
麻烦再帮我改改代码,万分感激!
当M例中的值等于AC1的值,提取所对应的值左边5例数值到AC2 ,谢谢
当S例中 ...

'试一下看看，，，

Option Explicit

Sub test()
  Dim arr, brr, i, j, k, m, n
  arr = [h2:y4].Value: brr = [ac1:ae1].Value
  ReDim crr(1 To UBound(arr, 1), 1 To UBound(arr, 2)) As String
  For j = 1 To UBound(arr, 2) Step 6
    For i = 1 To UBound(arr, 1)
      If arr(i, j + 5) = brr(1, (j - 1) / 6 + 1) Then
        m = m + 1
        For k = j To j + 4
          crr(m, k - n) = arr(i, k)
        Next
      End If
    Next
    m = 0: n = n + 1
  Next
  [ac2].Resize(UBound(crr, 1), UBound(crr, 2)) = crr
End Sub

霜雪GILL

一把小刀闯天下 发表于 2019-10-13 10:17
'试一下看看，，，

Option Explicit

谢谢，很好用，如果能送100朵小花的话会全送给你：）

3201967906

小刀老师写代码又快又好用啊

3201967906

霜雪GILL 发表于 2019-10-13 21:16
谢谢，很好用，如果能送100朵小花的话会全送给你：）

你这个表格输入数字是怎么固定字的大小为14的呢？

liulang0808

代码见截图

霜雪GILL

liulang0808 发表于 2019-10-15 18:18
代码见截图

请，麻烦，感谢！