求助：根据明细表生成对应模板

cindy88sy

各位大佬，不好意思。小弟新人小白，还不懂如何简短意骇的把问题描述清楚。经大佬提点，已做更改，加了些描述说明。请大佬们见谅！

数据源表：

需要生成的结果表：
1、评估表：


2、买入模板：


3、卖出模板



需求说明：
1、评估表：today当天交易的买卖数据。
   数据提取：
   
2、买入与卖出模板：
点击生成按钮时，增加两个选项：一个“交易时间”选项和“债券类型”选项。
   买入模板数据提取：
  

   卖出模板数据提取：
   

3、模板可以是word，也可以是excel，怎么方便怎么来。

LIUZHU

看起来工作量不小

cindy88sy

LIUZHU 发表于 2024-4-7 11:04
看起来工作量不小

是的 确实是的

xsy我可以很好

https://club.excelhome.net/forum ... ;page=2#pid11469973

昨天用公式做了一个类似的引用，慢慢修改吧

3190496160

别人不是做你的工作的，对你的工作不了解，所以，你的具体描述你的需求，比如，各个模板中的每一项从明细表的哪个位置取数，目前模板中的一些项目，在明细表中根本就找不到的

cindy88sy

3190496160 发表于 2024-4-7 14:18
别人不是做你的工作的，对你的工作不了解，所以，你的具体描述你的需求，比如，各个模板中的每一项从明细表 ...

是的，我的问题。已经做了更改。谢谢大佬提点。

cindy88sy

xsy我可以很好 发表于 2024-4-7 12:10
https://club.excelhome.net/forum.php?mod=viewthread&tid=1688824&page=2#pid11469973

昨天用公式做了 ...

谢谢，我研究看看

3190496160

Sub 生成评估表()
Application.ScreenUpdating = False
Dim ar As Variant
Dim rn As Range
Dim i As Long, r As Long, rs As Long
Dim br()
With Sheets("明细表")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    If r < 4 Then MsgBox "明细表为空！": End
    ar = .Range(.Cells(3, 1), .Cells(r, 28))
    zd = Format(Application.Max(.Range("r4:r" & r)), "yyyy/m/d")
End With
ReDim br(1 To UBound(ar), 1 To 6)
For i = 2 To UBound(ar)
    If ar(i, 18) <> "" Then
        If IsDate(ar(i, 18)) Then
            If ar(i, 18) = CDate(zd) Then
                n = n + 1
                If ar(i, 24) <> "" And ar(i, 26) <> "" Then
                    xz = "卖出"
                    br(n, 1) = "二级卖出"
                Else
                    br(n, 1) = "二级买入"
                    xz = "买入"
                End If
                br(n, 2) = ar(i, 28)
                br(n, 3) = ar(i, 2)
                br(n, 4) = ar(i, 4)
                br(n, 5) = ar(i, 15)
                br(n, 6) = ar(i, 27)
                If mc = "" Then
                    mc = ar(i, 4) & "债券与上海国际、上海国利、省内农商行等询价" & xz & "，交易对手为 "
                Else
                   mc = mc & Chr(10) & ar(i, 4) & "债券与上海国际、上海国利、省内农商行等询价" & xz & "，交易对手为 "
                End If
            End If
        End If
    End If
Next i
With Sheets("评估表")
    Set rn = .Columns(1).Find("项目简介", , , , , , 1)
    If rn Is Nothing Then MsgBox "评估表中缺少 项目简介 标识字段": End
    js = rn.Row
    .Cells(js, 2) = mc
    If js >= 4 Then .Range("b4:k" & js - 1) = Empty
    hs = js - 4
    If hs < n Then
        ys = n - hs
        .Rows(js - 1 & ":" & js + ys - 2).Insert Shift:=xlDown
    ElseIf hs > n Then
        .Rows(n + 4 & ":" & js - 1).Delete
    End If
    .[b4].Resize(n, UBound(br, 2)) = br
    .[b4].Resize(n, UBound(br, 2)).Borders.LineStyle = 1
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

生成模板.rar (68.87 KB, 下载次数: 12)

2024-4-8 15:16 上传

点击文件名下载附件

3190496160

只写了生成评估表的代码，供参考