Excel（WSP表格）区域内单元格渐变色填充设置（从左至右、从上至下、左上至右下……）

需求来源

        本人所在公司办公模式较老旧，所有数据处理工作的分享、展示之类均采用WPS表格实现，相比Excel更是阉割了许多功能，尤其是我本次用到的，文本框(各种插入的图形)的动态赋值：

        如上图，使用Excel时能点击红框处进行动态赋值，而且能够将字体格式应用，而WPS不行。

        本人接到工作，要用WPS做一个稍微好看一点的的数据看板，就需要大量使用上述模式。制作时用Excel，再用WPS打开也可以实现动态赋值，当我做完模板后发送给其它同事实现其它功能时，他那边用WPS居然无法正常显示（难受的雅痞）。这样我就只能摒弃文本框的模式，直接再表格里面赋值了。然而新的问题出现，我文本框里面的“相当精美”的渐变色怎么在一片单元格内实现呢？合并多个单元格在直接设置渐变色？这样不行，我的看板里面一个模块有许多需赋值内容，这就不能合并，而一个模块自然是展示一种渐变色才好看，所以就有了区域内单元格渐变色填充的需求

解决办法

一、粗暴版：vba脚本

        在网络上寻找许久之后终于找到了心怡的vba脚本，本人稍作修改，原帖中仅有自定义颜色从上到下的渐变填充，本人补充自定义颜色从左到右的渐变填充。xColor1,xColor2可以修改自定义的两个颜色（按RGB值）代码如下：

'从上到下的渐变色
Sub colorgradientmultiplecellsTtoB()
    'Updateby Extendoffcie
    Dim xRg As Range
    Dim xTxt As String
    Dim xCell As Range
    Dim xColor1 As Long
    Dim xColor2 As Long
    Dim I As Long
    Dim K As Long
    Dim xCount As Long
    On Error Resume Next
    If ActiveWindow.RangeSelection.Count > 1 Then
        xTxt = ActiveWindow.RangeSelection.AddressLocal
    Else
        xTxt = ActiveSheet.UsedRange.AddressLocal
    End If
LInput:
    Set xRg = Application.InputBox("Please select the cells range:", "Kutools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    If xRg.Areas.Count > 1 Then
        MsgBox "Does not support multiple selections", vbInformation, "Kutools for Excel"
        GoTo LInput
    End If
    On Error Resume Next
    Application.ScreenUpdating = False
    xCount = xRg.Rows.Count
    xColor1 = RGB(255, 255, 0) ' Red color
    xColor2 = RGB(0, 0, 255) ' Blue color
    For K = 1 To xRg.Columns.Count
        For I = xCount To 1 Step -1
            xRg.Cells(I, K).Interior.Color = RGB( _
                Int((xCount - (I - 1)) / xCount * (xColor2 Mod 256) + (I - 1) / xCount * (xColor1 Mod 256)), _
                Int((xCount - (I - 1)) / xCount * ((xColor2 \ 256) Mod 256) + (I - 1) / xCount * ((xColor1 \ 256) Mod 256)), _
                Int((xCount - (I - 1)) / xCount * (xColor2 \ 65536) + (I - 1) / xCount * (xColor1 \ 65536)))
        Next
    Next
    Application.ScreenUpdating = True
End Sub

'从左至右的渐变色
Sub colorgradientmultiplecellsLtoR()
    'Updateby Extendoffcie
    Dim xRg As Range
    Dim xTxt As String
    Dim xCell As Range
    Dim xColor1 As Long
    Dim xColor2 As Long
    Dim I As Long
    Dim K As Long
    Dim xCount As Long
    On Error Resume Next
    If ActiveWindow.RangeSelection.Count > 1 Then
        xTxt = ActiveWindow.RangeSelection.AddressLocal
    Else
        xTxt = ActiveSheet.UsedRange.AddressLocal
    End If
LInput:
    Set xRg = Application.InputBox("Please select the cells range:", "Kutools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    If xRg.Areas.Count > 1 Then
        MsgBox "Does not support multiple selections", vbInformation, "Kutools for Excel"
        GoTo LInput
    End If
    On Error Resume Next
    Application.ScreenUpdating = False
    xCount = xRg.Columns.Count
    xColor1 = RGB(255, 255, 0) ' Red color
    xColor2 = RGB(0, 0, 255) ' Blue color
    For I = 1 To xRg.Rows.Count
        For K = xCount To 1 Step -1
            xRg.Cells(I, K).Interior.Color = RGB( _
                Int((xCount - (K - 1)) / xCount * (xColor1 Mod 256) + (K - 1) / xCount * (xColor2 Mod 256)), _
                Int((xCount - (K - 1)) / xCount * ((xColor1 \ 256) Mod 256) + (K - 1) / xCount * ((xColor2 \ 256) Mod 256)), _
                Int((xCount - (K - 1)) / xCount * (xColor1 \ 65536) + (K - 1) / xCount * (xColor2 \ 65536)))
        Next
    Next
    Application.ScreenUpdating = True
End Sub

        以防有些小伙伴不会使用VBA，本人在此处做一个简短的指导：

        1.打开Excel（wps表格），按下Alt+F11，进入VBA编辑界面

        2.点击插入-模块，将上述代码复制，关闭VBA编辑窗口（无需保存之类的操作）

        3.点击开发工具-宏-执行，选择一个区域点击确定即可，如下图所示

注：该VBA脚本仅能实现上下左右的渐变填充，对于左上至右下这种复杂的填充模式就无法实现，望各位大神可以该进脚本

二、温柔版：条件格式->复制粘贴

        我们用条件格式-色阶实现区域渐变色，然后复制粘贴。但我们都知道条件格式是不改变单元格实际格式的，就比如上文提到的插入的文本框可以同时将文字格式引用，可以尝试设置了条件格式，再引用到文本框中会发现显示出来的还是原本格式。也就是说，你复制粘贴格式也会想条件格式粘贴，而我们不需要条件格式，想把单元格的实际格式修改，怎么办呢？（不用vba去获取条件格式的值了）有个比较”白痴“的方法：

        我们做了如下所示操作：

        1.将一个区域内填充数字（取决于你想要什么样的渐变，下示范左上至右下）

        2.设置条件格式-色阶

        3.复制填充区域，打开剪贴版

        4.新打开一个excel工作簿，选择粘贴位置，左击剪贴板区域

         5.第一次粘贴后将红框内的条件格式删除，再粘贴一次，发现没有条件格式，也有渐变填充

总结

        要么死磕VBA（还是希望有大神能够完善，用VBA多装B🤭），要么尝试稀奇古怪的操作。