VBA写入公式（5）：提取经济组织

Sub 取经济组织简称()
    Dim arr1, arrB
    Dim k As String
    Dim row2 As String
    Dim colu2 As String

    arr1 = Array("")


    arr15 = Array("")

    arr16 = Array("")
    
'    arrB = Array(arr1, arr2, arr3, arr4, arr5, arr6, arr7, arr8, arr9, arr10)
'    For b = LBound(arrB) To UBound(arrB)
'        k = arrB(b)
'        Debug.Print k
'    Next
'
'    Dim index As Integer
'    Dim arr() As String
'    For index = 1 To 5
'        Debug.Print (arr(3))
'        index = index + 1
'    Next
'
    Set rng1 = Application.InputBox(prompt:="选择数据源的一列区域", Type:=8)
'    MsgBox rng.Address
'    Range(rng.Address).Select
'
    rng1.Select
    Set rng2 = Application.InputBox(prompt:="选择保存结果一个单元格", Type:=8)
    row2 = rng2.Row
    colu2 = rng2.Column
    'rng2.Select
    'Debug.Print (Selection.Row)
    For Each i In rng1
    
        For j = LBound(arr1) To UBound(arr1)
            k = arr1(j)
           If InStr(i, k) Then
                Debug.Print (k)
                Cells(row2, colu2).Value = k
           End If
        Next
        
        For j = LBound(arr2) To UBound(arr2)
            k = arr2(j)
           If InStr(i, k) Then
                Debug.Print (k)
                Cells(row2, colu2).Value = k
           End If
        Next
        
        For j = LBound(arr3) To UBound(arr3)
            k = arr3(j)
           If InStr(i, k) Then
                Debug.Print (k)
                Cells(row2, colu2).Value = k
           End If
        Next
        
        
        For j = LBound(arr4) To UBound(arr4)
             k = arr4(j)
            If InStr(i, k) Then
                 Debug.Print (k)
                 Cells(row2, colu2).Value = k
            End If
        Next
            
        For j = LBound(arr5) To UBound(arr5)
             k = arr5(j)
            If InStr(i, k) Then
                 Debug.Print (k)
                 Cells(row2, colu2).Value = k
            End If
        Next

        For j = LBound(arr6) To UBound(arr6)
             k = arr6(j)
            If InStr(i, k) Then
                 Debug.Print (k)
                 Cells(row2, colu2).Value = k
            End If
        Next

        For j = LBound(arr7) To UBound(arr7)
             k = arr7(j)
            If InStr(i, k) Then
                 Debug.Print (k)
                 Cells(row2, colu2).Value = k
            End If
        Next
        
        For j = LBound(arr8) To UBound(arr8)
             k = arr8(j)
            If InStr(i, k) Then
                 Debug.Print (k)
                 Cells(row2, colu2).Value = k
            End If
        Next

        For j = LBound(arr9) To UBound(arr9)
             k = arr9(j)
            If InStr(i, k) Then
                 Debug.Print (k)

                 Cells(row2, colu2).Value = k
            End If
        Next

        For j = LBound(arr10) To UBound(arr10)
             k = arr10(j)
            If InStr(i, k) Then
                 Debug.Print (k)


                 Cells(row2, colu2).Value = k
            End If
        Next

        For j = LBound(arr11) To UBound(arr11)
             k = arr11(j)
            If InStr(i, k) Then
                 Debug.Print (k)


                 Cells(row2, colu2).Value = k
            End If
        Next

        For j = LBound(arr12) To UBound(arr12)
             k = arr12(j)
            If InStr(i, k) Then
                 Debug.Print (k)

                 Cells(row2, colu2).Value = k
            End If
        Next

        For j = LBound(arr13) To UBound(arr13)
             k = arr13(j)
            If InStr(i, k) Then
                 Debug.Print (k)

                 Cells(row2, colu2).Value = k
            End If
        Next

        For j = LBound(arr14) To UBound(arr14)
             k = arr14(j)
            If InStr(i, k) Then
                 Debug.Print (k)
                 Cells(row2, colu2).Value = k
            End If
        Next

        For j = LBound(arr15) To UBound(arr15)
             k = arr15(j)
            If InStr(i, k) Then
                 Debug.Print (k)
                 Cells(row2, colu2).Value = k
            End If
        Next

        For j = LBound(arr16) To UBound(arr16)
             k = arr16(j)
            If InStr(i, k) Then
                 Debug.Print (k)
                 Cells(row2, colu2).Value = k
            End If
        Next
        
        row2 = row2 + 1
    Debug.Print

    Next
End Sub