先谢谢各位大哥，能帮我看看怎么做才行么，要疯了

黑兔子

我们公司一个月要寄快3千张发票，但是呢，系统又乱七八糟的，寄给别人公司，地址相同要寄几个人，要么公司快递电话设置不完整，还要整合，开始我一个月一弄还行，就3000多张，结果疫情弄的累积城9000多张。要做疯了



可能看不清楚，就是A列要是票号，如果连续的同样客户，就用-代替，比如10111到10115那就要显示10111-115，不连续就要用/比如10111-115之后有个10117，那就只能。10111-115/10117，然后同样收件人还不能这么操作，得分两个顺丰运单号显示。。我该怎么办啊

黑兔子

做不了啊，通宵也完不成。。。

高

哪有什么10111之类的呀

心正意诚身修

感觉你说得也是迷迷糊糊的。

472597966

...表达太模糊，理解不了

天天打渔

不如就按地址/名字来筛选，票号也不用缩写，直接一个名全加上，最省事

rlz680926

你多给一点数据，可能别人更好理解一点，一个月有3000个寄件人，难免没有同姓名的

rlz680926

Sub test()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim y As Integer
Dim arr
Dim m
Dim n
arr = Range("a12:d16")
Dim brr(1 To 4, 1 To 4)
For i = 1 To UBound(arr)
    For j = 1 To UBound(brr)
        If arr(i, 2) & arr(i, 3) & arr(i, 4) = brr(j, 2) & brr(j, 3) & brr(j, 4) Then
            y = y + 1
            If y = 1 Then
               m = Right(arr(i, 1), 7)
               n = Right(brr(j, 1), 7)
               If Abs(m - n) = 1 Then
                    brr(j, 1) = brr(j, 1) & "-" & Right(arr(i, 1), 3)
               Else
                    brr(j, 1) = brr(j, 1) & "/" & arr(i, 1)
               End If
            Else
              m = Right(arr(i, 1), 7)
              n = Mid(brr(j, 1), 2, 4) & Right(brr(j, 1), 3)
              If Abs(m - n) = 1 Then
                    brr(j, 1) = brr(j, 1) & "-" & Right(arr(i, 1), 3)
               Else
                    brr(j, 1) = brr(j, 1) & "/" & arr(i, 1)
               End If
            End If
            GoTo 100
        End If
    Next
    k = k + 1
    brr(k, 1) = arr(i, 1): brr(k, 2) = arr(i, 2): brr(k, 3) = arr(i, 3): brr(k, 4) = arr(i, 4)
100
Next
Worksheets.Add(after:=Sheets(Sheets.Count)).Name = "汇总"
Sheets("汇总").Range("a1").Resize(UBound(brr), 4).NumberFormatLocal = "@"
Sheets("汇总").Range("a1").Resize(UBound(brr), 4) = brr

End Sub