Attribute VB_Name = "modLeads"
Option Explicit

' 新建线索：自动编号、写状态与创建日期、预铺公式区
Public Sub NewLead()
    Dim ws As Worksheet, r As Long
    Dim comp As String, person As String, phone As String, need As String
    Dim src As String, owner As String
    On Error GoTo ErrH
    comp = InputBox("公司名称：", "新建线索")
    If StrPtr(comp) = 0 Then Exit Sub
    If Trim(comp) = "" Then MsgBox "公司名称不能为空。": Exit Sub
    person = InputBox("联系人："): If StrPtr(person) = 0 Then Exit Sub
    phone = InputBox("联系电话："): If StrPtr(phone) = 0 Then Exit Sub
    need = InputBox("需求摘要："): If StrPtr(need) = 0 Then Exit Sub
    src = InputBox("来源（展会/官网留言/电话陌拜/老客户转介/广告投放）：", "新建线索", "官网留言")
    If StrPtr(src) = 0 Then Exit Sub
    owner = InputBox("负责人编号（如 S01）："): If StrPtr(owner) = 0 Then Exit Sub

    Set ws = Sh("线索")
    r = NextRow(ws, 1)
    ws.Cells(r, 1).Value = NextId(ws, 1, "L")
    ws.Cells(r, 2).Value = src
    ws.Cells(r, 3).Value = comp
    ws.Cells(r, 4).Value = person
    ws.Cells(r, 5).Value = "'" & phone
    ws.Cells(r, 6).Value = need
    ws.Cells(r, 7).Value = "待跟进"
    ws.Cells(r, 8).Value = Date
    ws.Cells(r, 9).Value = owner
    LeadFormulas ws, r
    ws.Activate
    ws.Cells(r, 1).Select
    MsgBox "已新建线索 " & ws.Cells(r, 1).Value & "，请尽快完成首次跟进。"
    Exit Sub
ErrH:
    Fail "新建线索"
End Sub

' 线索行 L:N 公式区（跟进次数/未跟进天数/距回收剩余）
Private Sub LeadFormulas(ws As Worksheet, r As Long)
    ws.Cells(r, 12).Formula = "=COUNTIFS(跟进记录!$D$2:$D$1000,A" & r & ",跟进记录!$C$2:$C$1000,""线索"")"
    ws.Cells(r, 13).Formula = "=参数!$B$3-IF(K" & r & "="""",H" & r & ",K" & r & ")"
    ws.Cells(r, 14).Formula = "=IF(OR(G" & r & "=""已转化"",G" & r & "=""无效"",G" & r & "=""已回收""),""已关闭"",MAX(0,参数!$B$4-M" & r & "))"
End Sub

' 记录跟进：追加跟进记录并回写线索最近跟进日期与状态
Public Sub LogFollowUp()
    Dim wsA As Worksheet, wsL As Worksheet, wsO As Worksheet, f As Range
    Dim key As String, typ As String, way As String, memo As String
    Dim nxtRaw As String, owner As String, r As Long
    On Error GoTo ErrH
    key = InputBox("对象编号（线索 L### 或商机 B###）：", "记录跟进")
    If StrPtr(key) = 0 Then Exit Sub
    key = UCase(Trim(key))
    If Left(key, 1) = "L" Then
        typ = "线索": Set wsL = Sh("线索")
        Set f = wsL.Columns(1).Find(key, LookAt:=xlWhole)
    ElseIf Left(key, 1) = "B" Then
        typ = "商机": Set wsO = Sh("商机")
        Set f = wsO.Columns(1).Find(key, LookAt:=xlWhole)
    Else
        MsgBox "编号需以 L（线索）或 B（商机）开头。": Exit Sub
    End If
    If f Is Nothing Then MsgBox "找不到编号 " & key & "。": Exit Sub
    way = InputBox("跟进方式（电话/微信/上门拜访/邮件/视频会议）：", "记录跟进", "电话")
    If StrPtr(way) = 0 Then Exit Sub
    memo = InputBox("内容摘要："): If StrPtr(memo) = 0 Then Exit Sub
    nxtRaw = InputBox("下次计划日期（可空，如 2026-10-08）："): If StrPtr(nxtRaw) = 0 Then Exit Sub
    owner = InputBox("经手人编号："): If StrPtr(owner) = 0 Then Exit Sub

    Set wsA = Sh("跟进记录")
    r = NextRow(wsA, 1)
    wsA.Cells(r, 1).Value = NextId(wsA, 1, "F")
    wsA.Cells(r, 2).Value = Date
    wsA.Cells(r, 3).Value = typ
    wsA.Cells(r, 4).Value = key
    wsA.Cells(r, 5).Value = way
    wsA.Cells(r, 6).Value = memo
    If Trim(nxtRaw) <> "" Then wsA.Cells(r, 7).Value = CDate(nxtRaw)
    wsA.Cells(r, 8).Value = owner
    If typ = "线索" Then
        f.Cells(1, 11).Value = Date          ' K 最近跟进日期
        If f.Cells(1, 7).Value = "待跟进" Then f.Cells(1, 7).Value = "跟进中"
        wsL.Activate
    Else
        wsO.Activate
    End If
    f.Cells(1, 1).Select
    MsgBox "已记录跟进 " & key & "，最近跟进日期已更新。"
    Exit Sub
ErrH:
    Fail "记录跟进"
End Sub

' 线索转商机：建公司/联系人档案、建商机、回写线索状态与公司编号
Public Sub ConvertLead()
    Dim wsL As Worksheet, wsC As Worksheet, wsP As Worksheet, wsO As Worksheet, f As Range
    Dim key As String, cid As String, dName As String, amtRaw As String, dueRaw As String
    Dim r As Long
    On Error GoTo ErrH
    key = InputBox("要转化的线索编号：", "线索转商机")
    If StrPtr(key) = 0 Then Exit Sub
    Set wsL = Sh("线索")
    Set f = wsL.Columns(1).Find(UCase(Trim(key)), LookAt:=xlWhole)
    If f Is Nothing Then MsgBox "找不到该线索。": Exit Sub
    If f.Cells(1, 7).Value <> "跟进中" And f.Cells(1, 7).Value <> "待跟进" Then
        MsgBox "仅跟进中或待跟进的线索可以转化。": Exit Sub
    End If
    Set wsC = Sh("客户公司"): Set wsP = Sh("联系人"): Set wsO = Sh("商机")
    cid = InputBox("客户公司编号（留空则按线索公司名称新建档案）：", "线索转商机")
    If StrPtr(cid) = 0 Then Exit Sub
    If Trim(cid) = "" Then
        cid = NextId(wsC, 1, "C")
        r = NextRow(wsC, 1)
        wsC.Cells(r, 1).Value = cid
        wsC.Cells(r, 2).Value = f.Cells(1, 3).Value
        wsC.Cells(r, 8).Value = Date
        wsC.Cells(r, 9).Value = "潜在"
        CompFormulas wsC, r
        MsgBox "已新建公司档案 " & cid & "，请补齐行业、地区、等级。"
    ElseIf wsC.Columns(1).Find(cid, LookAt:=xlWhole) Is Nothing Then
        MsgBox "公司编号 " & cid & " 不存在，请先建档。": Exit Sub
    End If
    ' 联系人归档：编号取 P 流水，姓名电话来自线索
    r = NextRow(wsP, 1)
    wsP.Cells(r, 1).Value = NextId(wsP, 1, "P")
    wsP.Cells(r, 2).Value = cid
    wsP.Cells(r, 3).Formula = "=VLOOKUP(B" & r & ",客户公司!$A$2:$B$100,2,FALSE)"
    wsP.Cells(r, 4).Value = f.Cells(1, 4).Value
    wsP.Cells(r, 8).Value = "'" & f.Cells(1, 5).Value
    dName = InputBox("商机名称：", "线索转商机")
    If StrPtr(dName) = 0 Or Trim(dName) = "" Then Exit Sub
    amtRaw = InputBox("商机金额："): If StrPtr(amtRaw) = 0 Then Exit Sub
    dueRaw = InputBox("预计成交日期（如 2026-10-15）："): If StrPtr(dueRaw) = 0 Then Exit Sub
    r = NextRow(wsO, 1)
    wsO.Cells(r, 1).Value = NextId(wsO, 1, "B")
    wsO.Cells(r, 2).Value = cid
    wsO.Cells(r, 3).Formula = "=VLOOKUP(B" & r & ",客户公司!$A$2:$B$100,2,FALSE)"
    wsO.Cells(r, 4).Value = dName
    wsO.Cells(r, 5).Value = "初步接触"
    wsO.Cells(r, 6).Value = CDbl(amtRaw)
    wsO.Cells(r, 7).Value = Date
    wsO.Cells(r, 8).Value = CDate(dueRaw)
    wsO.Cells(r, 9).Value = f.Cells(1, 9).Value
    wsO.Cells(r, 13).Value = f.Cells(1, 1).Value
    DealFormulas wsO, r
    f.Cells(1, 7).Value = "已转化"
    f.Cells(1, 10).Value = cid
    wsO.Activate
    wsO.Cells(r, 1).Select
    MsgBox "线索 " & f.Cells(1, 1).Value & " 已转化为商机，阶段为初步接触。"
    Exit Sub
ErrH:
    Fail "线索转商机"
End Sub

Private Sub CompFormulas(ws As Worksheet, r As Long)
    ws.Cells(r, 10).Formula = "=COUNTIF(线索!$J$2:$J$1000,A" & r & ")"
    ws.Cells(r, 11).Formula = "=COUNTIF(商机!$B$2:$B$1000,A" & r & ")"
    ws.Cells(r, 12).Formula = "=SUMIFS(订单!$E$2:$E$1000,订单!$C$2:$C$1000,A" & r & ")"
End Sub

Private Sub DealFormulas(ws As Worksheet, r As Long)
    ws.Cells(r, 10).Formula = "=VLOOKUP(E" & r & ",参数!$P$2:$Q$7,2,FALSE)"
    ws.Cells(r, 11).Formula = "=F" & r & "*J" & r
    ws.Cells(r, 12).Formula = "=COUNTIFS(跟进记录!$D$2:$D$1000,A" & r & ",跟进记录!$C$2:$C$1000,""商机"")"
    ws.Cells(r, 14).Formula = "=IF(OR(E" & r & "=""赢单"",E" & r & "=""输单""),""已定案"",IF(H" & r & "<参数!$B$3,""逾期未决"",""推进中""))"
End Sub

' 手动退回公海：线索标已回收，公海登记去向
Public Sub ReturnToPool()
    Dim wsL As Worksheet, wsP As Worksheet, f As Range
    Dim key As String, r As Long
    On Error GoTo ErrH
    key = InputBox("要退回公海的线索编号：", "手动退回公海")
    If StrPtr(key) = 0 Then Exit Sub
    Set wsL = Sh("线索")
    Set f = wsL.Columns(1).Find(UCase(Trim(key)), LookAt:=xlWhole)
    If f Is Nothing Then MsgBox "找不到该线索。": Exit Sub
    If f.Cells(1, 7).Value = "已回收" Then MsgBox "该线索已在公海。": Exit Sub
    Set wsP = Sh("公海")
    r = NextRow(wsP, 1)
    wsP.Cells(r, 1).Value = f.Cells(1, 1).Value
    wsP.Cells(r, 2).Value = f.Cells(1, 3).Value
    wsP.Cells(r, 3).Value = f.Cells(1, 4).Value
    wsP.Cells(r, 4).Value = "'" & f.Cells(1, 5).Value
    wsP.Cells(r, 5).Value = f.Cells(1, 2).Value
    wsP.Cells(r, 6).Value = f.Cells(1, 6).Value
    wsP.Cells(r, 7).Value = f.Cells(1, 9).Value
    wsP.Cells(r, 8).Value = Date
    wsP.Cells(r, 9).Value = "手动退回"
    wsP.Cells(r, 10).Value = "待申领"
    f.Cells(1, 7).Value = "已回收"
    wsP.Activate
    wsP.Cells(r, 1).Select
    MsgBox "线索 " & key & " 已退回公海待申领。"
    Exit Sub
ErrH:
    Fail "手动退回公海"
End Sub

' 公海自动回收：按参数表天数扫描跟进中超期线索，搬入公海并留痕
Public Sub RecyclePool()
    Dim wsL As Worksheet, wsP As Worksheet
    Dim r As Long, n As Long, lastTouch As Double
    Dim cutoff As Double, limitDays As Double
    On Error GoTo ErrH
    Set wsL = Sh("线索"): Set wsP = Sh("公海")
    cutoff = Sh("参数").Range("B3").Value
    limitDays = Sh("参数").Range("B4").Value
    Application.ScreenUpdating = False
    For r = 2 To wsL.Cells(wsL.Rows.Count, 1).End(xlUp).Row
        If wsL.Cells(r, 7).Value = "跟进中" Then
            If IsEmpty(wsL.Cells(r, 11).Value) Or wsL.Cells(r, 11).Value = "" Then
                lastTouch = wsL.Cells(r, 8).Value
            Else
                lastTouch = wsL.Cells(r, 11).Value
            End If
            If cutoff - lastTouch > limitDays Then
                Dim pr As Long
                pr = NextRow(wsP, 1)
                wsP.Cells(pr, 1).Value = wsL.Cells(r, 1).Value
                wsP.Cells(pr, 2).Value = wsL.Cells(r, 3).Value
                wsP.Cells(pr, 3).Value = wsL.Cells(r, 4).Value
                wsP.Cells(pr, 4).Value = "'" & wsL.Cells(r, 5).Value
                wsP.Cells(pr, 5).Value = wsL.Cells(r, 2).Value
                wsP.Cells(pr, 6).Value = wsL.Cells(r, 6).Value
                wsP.Cells(pr, 7).Value = wsL.Cells(r, 9).Value
                wsP.Cells(pr, 8).Value = Date
                wsP.Cells(pr, 9).Value = "超期未跟进"
                wsP.Cells(pr, 10).Value = "待申领"
                wsL.Cells(r, 7).Value = "已回收"
                n = n + 1
            End If
        End If
    Next r
    Application.ScreenUpdating = True
    MsgBox "本次回收 " & n & " 条超期线索进公海（规则：超过 " & limitDays & " 天未跟进）。"
    Exit Sub
ErrH:
    Application.ScreenUpdating = True
    Fail "公海自动回收"
End Sub

' 公海申领：校验上限，登记去向并在线索表重新开号激活
Public Sub ClaimPool()
    Dim wsL As Worksheet, wsP As Worksheet, f As Range
    Dim key As String, newOwner As String, r As Long
    On Error GoTo ErrH
    key = InputBox("要申领的公海线索编号：", "公海申领")
    If StrPtr(key) = 0 Then Exit Sub
    Set wsP = Sh("公海")
    Set f = wsP.Columns(1).Find(UCase(Trim(key)), LookAt:=xlWhole)
    If f Is Nothing Then MsgBox "公海中找不到该编号。": Exit Sub
    If f.Cells(1, 10).Value <> "待申领" Then MsgBox "该线索已被申领。": Exit Sub
    newOwner = InputBox("新负责人编号："): If StrPtr(newOwner) = 0 Then Exit Sub
    If Application.WorksheetFunction.CountIf(wsP.Range("L:L"), newOwner) >= Sh("参数").Range("B5").Value Then
        MsgBox newOwner & " 的申领数已达上限，请先跟进存量。": Exit Sub
    End If
    f.Cells(1, 10).Value = "已申领"
    f.Cells(1, 11).Value = Date
    f.Cells(1, 12).Value = newOwner
    Set wsL = Sh("线索")
    r = NextRow(wsL, 1)
    wsL.Cells(r, 1).Value = NextId(wsL, 1, "L")
    wsL.Cells(r, 2).Value = f.Cells(1, 5).Value
    wsL.Cells(r, 3).Value = f.Cells(1, 2).Value
    wsL.Cells(r, 4).Value = f.Cells(1, 3).Value
    wsL.Cells(r, 5).Value = "'" & f.Cells(1, 4).Value
    wsL.Cells(r, 6).Value = f.Cells(1, 6).Value
    wsL.Cells(r, 7).Value = "跟进中"
    wsL.Cells(r, 8).Value = Date
    wsL.Cells(r, 9).Value = newOwner
    LeadFormulas wsL, r
    wsL.Activate
    wsL.Cells(r, 1).Select
    MsgBox "申领完成，已在线索表重新开号为 " & wsL.Cells(r, 1).Value & "。"
    Exit Sub
ErrH:
    Fail "公海申领"
End Sub