Excel 如何使用VBA实现

Sub 银行合并()

      

      Application.ScreenUpdating = False

      Dim wh As Worksheet, sh As Worksheet

      Dim last_column%, str As String, last_row As Integer, n As Integer, a As Integer

      Dim crr(), arr(), brr()

      Set wh = Worksheets("4合账草稿")

      With wh

            last_column = .Cells(1, Columns.Count).End(xlToLeft).Column

            arr = .Range(.Cells(1, 1), .Cells(1, last_column))

           

      End With

      

      For Each sh In Worksheets

            If sh.Name = wh.Name Then Exit For

            With sh

                  last_column = .Cells(1, Columns.Count).End(xlToLeft).Column

                  last_row = .Cells(Rows.Count, 1).End(xlUp).Row

                  brr = .Range(.Cells(1, 1), .Cells(last_row, last_column))

                  For i = 2 To UBound(brr)

                        n = n + 1

                        ReDim Preserve crr(1 To UBound(arr, 2), 1 To n)

                        For k = 1 To UBound(arr, 2)

                              For j = 1 To UBound(brr, 2)

                                    If InStr(1, Trim(arr(1, k)), Trim(brr(1, j)), vbBinaryCompare) > 0 Then

                                          crr(k, n) = brr(i, j)

                                    End If

                              Next j

                        Next k

                  Next i

            End With

      Next

      wh.Range("a2:k65536").ClearContents

      wh.Range("a2").Resize(UBound(crr, 2), 11) = Application.Transpose(crr)

      Application.ScreenUpdating = True

      

End Sub