老师，请教一下如果中间出现目标列出现空格自动删除

宝贝优博

Sub cf()
Dim arr, brr()
Set d = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    For Each sh In Worksheets
        If sh.Name <> "数据汇总" Then sh.Delete
    Next
Application.DisplayAlerts = True
arr = Range("a1:l" & Cells(Cells.Rows.Count, 1).End(3).Row)
u1 = UBound(arr): u2 = UBound(arr, 2)
    For i = 2 To u1
        d(arr(i, 3)) = ""
    Next
    shs = d.keys
    For Each sh In shs
        ReDim brr(1 To u1, 1 To u2)
        Worksheets.Add after:=Sheets(Sheets.Count)
        ActiveSheet.Name = sh
            For i = 2 To u1
                If arr(i, 3) = sh Then
                    n = n + 1
                    For j = 1 To u2
                        brr(n, j) = arr(i, j)
                    Next
                End If
             Next
    Worksheets("数据汇总").Range("a2:l" & n + 1).Copy
    ActiveSheet.Range("a2").PasteSpecial Paste:=xlPasteColumnWidths
    ActiveSheet.Range("a2").PasteSpecial Paste:=xlPasteFormats
    Worksh

yjh_27

没附件，猜一下
For i = 2 To u1
        if len(arr(i, 3)) then d(arr(i, 3)) = ""
    Next