好不好才能打出心形字符？

用键盘打?;：先在没输入法的任务栏那，按shift键打&，再放开shift打9825;（分号别忘），然后点论坛回复按钮。要是出来数字就再编辑下，肯定能行。这样会发现个秘密，就是?;（这里没空格哈）。

下面的程序能满足你的要求，效果见附图
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Const Data = "8,22,8,23,7,24,6,24,5,25,4,26,3,27,3,28,2,29,2,30,2,31,2,32,2,33,2,34,2,35,2,36,3,37,4,38,5,39,6,40,7," & _
                "41,8,42,9,42,10,43,11,43,12,43,13,43,14,43,15,43,16,43,17,43,18,43,19,43,20,42,21,41,22,41,23,41,24,40," & _
                "25,40,26,39,27,39,28,38,29,38,30,37,31,37,32,36,33,36,33,35,34,35,34,34,35,34,35,33,36,33,36,32,37,32," & _
                "37,31,38,31,38,30,39,30,40,29,41,28,42,27,43,26,44,25,45,24,46,23,46,22,47,21,47,20,48,19,48,18,49,17,49," & _
                "16,50,15,50,14,49,14,48,14,47,14,46,14,45,13,44,13,43,13,42,13,41,13,40,13,39,13,38,12,37,12,36,12,35,11," & _
                "34,11,33,10,32,10,31,9,30,8,29,7,28,7,28,6,27,6,26,5,25,5,25,4,24,4,23,4,22,3,21,2,20,2,19,2,18,1,17,1,16," & _
                "1,15,1,14,1,13,1,12,2,11,2,10,2,9,2,8,3,7,3,7,4,6,4,5,5,4,6,3,7,2,8,2,9,2,10,1,11,1,12,1,13,1,14,2,15,2,16," & _
                "2,17,3,18,4,19,5,20,6,21,13,16,13,15,13,14,13,13,14,12,15,11,16,11,17,11,18,11,19,11,19,12,20,12,20,13,20,14," & _
                "20,15,20,16,19,17,18,18,17,19,16,20,15,20,14,20,13,20,13,19,13,18,14,17,15,17,16,16,17,15,18,15,19,14,21,14," & _
                "22,14,23,13,24,12,25,11,25,10,25,9,24,8,23,9,23,10,23,11,24,13,25,14,25,15,24,16,23,17,22,18,21,18,20,19,20," & _
                "20,21,20,22,19,23,19,24,19,25,19,25,20,25,21,24,22,23,22,22,23,21,23,20,23,19,22,20,21,21,21,22,21,24,23,23," & _
                "23,23,24,22,24,22,25,21,25,21,26,20,26,20,27,20,28,21,28,22,27,23,27,23,26,24,26,25,26,25,27,25,28,24,29,23," & _
                "30,22,30,21,31,20,31,19,30,20,29,21,29,22,29,23,29,23,31,22,32,21,33,20,33,22,33,23,33,23,34,23,35,22,36,21," & _
                "37,20,37,19,36,19,35,20,34,24,33,25,33,25,34,25,35,25,36,24,36,23,37,22,38,21,39,20,40"
    Const DelayValue = 5000
    Const COffset = 15
    Const ROffset = 10
    Dim DD, Love(), I As Integer, J As Integer
    Love = Array("*", "l", "o", "v", "e")
    Application.DisplayAlerts = False
    ActiveSheet.Cells.ClearContents
    ActiveSheet.Rows.RowHeight = 8
    ActiveSheet.Columns.ColumnWidth = 1
    ActiveSheet.Cells.Font.ColorIndex = 3
    ActiveSheet.Cells.Font.Size = 6
    Application.WindowState = xlMaximized
    With ActiveWindow
        .DisplayGridlines = False
        .DisplayHeadings = False
        .DisplayHorizontalScrollBar = False
        .DisplayVerticalScrollBar = False
        .DisplayWorkbookTabs = False
    End With
    With Application
        .DisplayFormulaBar = False
        .DisplayStatusBar = False
    End With
    Application.CommandBars("Standard").Visible = False
    Application.CommandBars("Formatting").Visible = False
    Application.CommandBars("Visual Basic").Visible = False
    Application.CommandBars("Drawing").Visible = False
'    Application.CommandBars("Worksheet Menu Bar").Visible = False
    DD = Split(Data, ",")
    Cells(1, 1).Select
    For I = 0 To UBound(DD) Step 2
        For J = 1 To DelayValue
            DoEvents
        Next
        Cells(Val(DD(I)) + ROffset, Val(DD(I + 1)) + COffset) = Love((I / 2) Mod 5)
    Next
End Sub

导入心形文字

再看看别人怎么说的。

复制得咯。 ☆﹀╮ ╲╱.

下面的程序能满足你的要求，效果见附图
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Const Data = "8,22,8,23,7,24,6,24,5,25,4,26,3,27,3,28,2,29,2,30,2,31,2,32,2,33,2,34,2,35,2,36,3,37,4,38,5,39,6,40,7," & _
                "41,8,42,9,42,10,43,11,43,12,43,13,43,14,43,15,43,16,43,17,43,18,43,19,43,20,42,21,41,22,41,23,41,24,40," & _
                "25,40,26,39,27,39,28,38,29,38,30,37,31,37,32,36,33,36,33,35,34,35,34,34,35,34,35,33,36,33,36,32,37,32," & _
                "37,31,38,31,38,30,39,30,40,29,41,28,42,27,43,26,44,25,45,24,46,23,46,22,47,21,47,20,48,19,48,18,49,17,49," & _
                "16,50,15,50,14,49,14,48,14,47,14,46,14,45,13,44,13,43,13,42,13,41,13,40,13,39,13,38,12,37,12,36,12,35,11," & _
                "34,11,33,10,32,10,31,9,30,8,29,7,28,7,28,6,27,6,26,5,25,5,25,4,24,4,23,4,22,3,21,2,20,2,19,2,18,1,17,1,16," & _
                "1,15,1,14,1,13,1,12,2,11,2,10,2,9,2,8,3,7,3,7,4,6,4,5,5,4,6,3,7,2,8,2,9,2,10,1,11,1,12,1,13,1,14,2,15,2,16," & _
                "2,17,3,18,4,19,5,20,6,21,13,16,13,15,13,14,13,13,14,12,15,11,16,11,17,11,18,11,19,11,19,12,20,12,20,13,20,14," & _
                "20,15,20,16,19,17,18,18,17,19,16,20,15,20,14,20,13,20,13,19,13,18,14,17,15,17,16,16,17,15,18,15,19,14,21,14," & _
                "22,14,23,13,24,12,25,11,25,10,25,9,24,8,23,9,23,10,23,11,24,13,25,14,25,15,24,16,23,17,22,18,21,18,20,19,20," & _
                "20,21,20,22,19,23,19,24,19,25,19,25,20,25,21,24,22,23,22,22,23,21,23,20,23,19,22,20,21,21,21,22,21,24,23,23," & _
                "23,23,24,22,24,22,25,21,25,21,26,20,26,20,27,20,28,21,28,22,27,23,27,23,26,24,26,25,26,25,27,25,28,24,29,23," & _
                "30,22,30,21,31,20,31,19,30,20,29,21,29,22,29,23,29,23,31,22,32,21,33,20,33,22,33,23,33,23,34,23,35,22,36,21," & _
                "37,20,37,19,36,19,35,20,34,24,33,25,33,25,34,25,35,25,36,24,36,23,37,22,38,21,39,20,40"
    Const DelayValue = 5000
    Const COffset = 15
    Const ROffset = 10
    Dim DD, Love(), I As Integer, J As Integer
    Love = Array("*", "l", "o", "v", "e")
    Application.DisplayAlerts = False
    ActiveSheet.Cells.ClearContents
    ActiveSheet.Rows.RowHeight = 8
    ActiveSheet.Columns.ColumnWidth = 1
    ActiveSheet.Cells.Font.ColorIndex = 3
    ActiveSheet.Cells.Font.Size = 6
    Application.WindowState = xlMaximized
    With ActiveWindow
        .DisplayGridlines = False
        .DisplayHeadings = False
        .DisplayHorizontalScrollBar = False
        .DisplayVerticalScrollBar = False
        .DisplayWorkbookTabs = False
    End With
    With Application
        .DisplayFormulaBar = False
        .DisplayStatusBar = False
    End With
    Application.CommandBars("Standard").Visible = False
    Application.CommandBars("Formatting").Visible = False
    Application.CommandBars("Visual Basic").Visible = False
    Application.CommandBars("Drawing").Visible = False
'    Application.CommandBars("Worksheet Menu Bar").Visible = False
    DD = Split(Data, ",")
    Cells(1, 1).Select
    For I = 0 To UBound(DD) Step 2
        For J = 1 To DelayValue
            DoEvents
        Next
        Cells(Val(DD(I)) + ROffset, Val(DD(I + 1)) + COffset) = Love((I / 2) Mod 5)
    Next
End Sub