有没有办法使用 VBA 转置 HTML 表格？

Question

我有一个宏允许我向每个经理发送每月绩效的电子邮件。 代码如下：

Sub OutlookEmailsSend()
    
    Dim objOutlook As Outlook.Application
    Dim objMail As Outlook.MailItem
    Dim lCounter As Long
    Dim endColumnNo As Long
    Dim a As Long
    Dim sFile As String
    
    endColumnNo = ThisWorkbook.Sheets("Sheet1").UsedRange.Columns.Count
    
    Set objOutlook = Outlook.Application
   
    For lCounter = 2 To 3
        '
        Set objMail = objOutlook.CreateItem(olMailItem)
        
        objMail.To = Sheet1.Range("B" & lCounter).Value
              
        objMail.Subject = "Sales Summary"
        
        sFile = "Dear,<br><br>Please refer to below table for your performance<br><br><table border=1>"
        
        For a = 1 To endColumnNo
            sFile = sFile & "<tr><td>" & Cells(1, a) & "</td><td>" & Cells(lCounter, a) & "</td></tr>"
        Next
        
        objMail.HTMLBody = sFile
        
        objMail.Display
       
        Set objMail = Nothing
    Next
    
End Sub

像这样的宏产生表

Dear,

Please refer to below table for your performance

Name    Tom
Email   sgcjack@163.com
Item    Phone
Sales   123
Bonus   3213

但是，我希望表格如下

Name    Email                   Item     Sales  Bonus
Jack    jacksun@citics.com.hk   Computer 342    23123

有什么办法可以做到这一点？

Answer 1

为了更好的可读性，在函数中组织 html 创建并将函数结果分配给objMail.HTMLBody省略循环可能会有所帮助。

顺便说一句，您忘记了结束表格标记</table> ，这不会导致有效的 html 结构。 - 当然，遵循原始代码最直接的方法是遵循评论中的建议，在循环外添加<tr>..</tr>标签，不要忘记结束</table>标签。

    With Sheet1
        objMail.HTMLBody = getBody(.Range("A1",.Cells(1,EndColumnNo)),"Dear xx")`
    End With

帮助函数getBody()基于 (c) 明确定义的表结构连接 (a) 标题和 (b) 表数据。

注意：您也可以尝试将该定义更改为具有单独标题标签的更复杂的 html 代码。 .

Function getBody(rng    As Range, _
    Optional greetings  As String = "", _
    Optional HeaderList As String = "Name,Email,Item,Sales,Bonus")
Const Blanks As String = "  "
'a) get headers
    Dim headers As String
    headers = "  <td>" & Replace(HeaderList, ",", "</td><td>") & "</td>"
'b) join table data "<td>..</td>"
    Dim data As String
    data = Blanks & _
        Join(rng.Parent.Evaluate("""<td>""&" & rng.Address(0, 0) & " & ""</td>""") _
        , vbNewLine & Blanks)
'c) define table structure
    Dim tags()
    tags = Array(greetings, _
        "<table border='1'>", _
        " <tr>", headers, " </tr>", _
        " <tr>", data, " </tr>", _
        "</table>")
'd) return joined function result
    getBody = Join(tags, vbNewLine)
End Function