8.2 Excel技巧

1 如何动态修改excel的输出结果行数

https://blog.csdn.net/ppzgghgzshpph/article/details/117934691
比如计算水面线，有时需要输出10行，步长为100m，有时候需要输出20行，步长为50m
利用下面这段VBA代码“内置事件”功能，自动监听单元格内数值变化，然后执行复制粘贴代码，从而实现此功能。
首先，※：函数要定义在 对应的【SheetN】中；
Alt+F11调出Microsoft Visual Basic for Applications窗口，双击该文件下的相应的Sheet，例如Sheet1，在右侧出现的Sheet1 （代码）窗口的左上部选择Worksheet，在其右边的选择框中选择Change。下方的代码区则自动生成相应的代码段。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ThisCol As Integer, ThisRow As Long, CurS As Worksheet, CurRg As Range, InfCol As Integer
    Set CurS = ActiveSheet

    '打算输出（拷贝）多少行，单元格地址如下：
    InfRol = 3 'row '3'
    InfCol = 2 'column 'B'

    '复制的对象/区域地址如下：
    targrow = 5 '目标行
    targcol = 5 '目标列
    targcols = 3 '多少列

    Range(CurS.Cells(targrow, targcol), CurS.Cells(targrow, targcol + targcols - 1)).Select

    '粘贴的起始单元格地址如下：
    ThisRow = 5 'ActiveCell.Row
    ThisCol = 2 'ActiveCell.Column

  If Target.Cells.Count > 1 Then
    '如果目标区域含有多个单元格 则退出
    Exit Sub
  End If

  If Target.Column <> InfCol Or Target.Row <> InfRol Then
    '如果目标单元格不是定义的单元格 则退出
    Exit Sub
  End If

  If Target.Value <= 0 Or Target.Value > 100 Then
    '如果复制的行数小于等于0，或者大于100，则退出
    Exit Sub
  Else
    Application.CutCopyMode = False
    Selection.Copy
    Set CurRg = Range(CurS.Cells(ThisRow, ThisCol), CurS.Cells(ThisRow + CurS.Cells(InfRol, InfCol).Value - 1, ThisCol + targcols - 1))
    CurRg.Select
    CurRg.PasteSpecial (xlPasteAll)
  End If
End Sub

2 显式计算

就是将计算过程显示出来，传统的计算过程显示了引用的单元格，而下面的代码，将计算过程中引用的单元格直接替换成被引用单元格内的数值。如下图，计算过程显示的引用单元格B2和B3，用了ShowFormula函数后，显示的被引用单元格里的数字10和5.5。

Option Explicit
Option Base 1
Function ShowFormula(x As Range) As String
    Dim i As Integer, j As Integer, s As String, s1 As String, r, re As String, b As Integer, c As Integer, xx As String, n As Integer, k As Integer
    If x.Rows.Count > 1 Or x.Columns.Count > 1 Then Exit Function
    xx = x.Formula
    n = Len(xx)
    i = 1
    j = 2
    If j > n Then Exit Function
    Do Until i > n
        If Mid(xx, i, 1) = "$" And k = 0 Then j = j + 1
        k = 1
        s1 = Mid(xx, j, 1)
        If s1 = "$" Then j = j + 1
        s = Mid(xx, i, j - i + 1)
        If IsError(Application.Evaluate("indirect(" & Chr(34) & s & Chr(34) & ")")) Then
            If j + 1 <= n Then
                If IsError(Application.Evaluate("indirect(" & Chr(34) & s & Mid(xx, j + 1, 1) & Chr(34) & ")")) Then
                    If b = 1 Then
                        If s1 = ":" Then
                            c = 1
                            re = re & s
                            i = j + 1
                            j = i + 1
                            k = 0
                        Else
                            If c = 1 Then
                                re = re & s
                                i = j + 1
                                j = i + 1
                                c = 0
                                k = 0
                            Else
                                re = re & r & s1
                                i = j + 1
                                j = i + 1
                            End If
                        End If
                        b = 0
                    Else
                        re = re & Mid(xx, i, 1)
                        i = i + 1
                        j = i + 1
                        k = 0
                    End If
                Else
                    j = j + 1
                    s = s & Mid(xx, j, 1)
                    r = Val(Application.Evaluate("indirect(" & Chr(34) & s & Chr(34) & ")"))
                    r = Round(r, 3)
                    b = 1
                    j = j + 1
                    If j > n Then
                        If c = 1 Then
                            re = re & s
                        Else
                            re = re & r
                        End If
                        Exit Do
                    End If
                End If
            Else
                If b = 1 Then
                    If c = 1 Then
                        re = re & s
                    Else
                        re = re & r & s1
                    End If
                Else
                    re = re & s
                End If
                Exit Do
            End If
        Else
            r = Val(Application.Evaluate("indirect(" & Chr(34) & s & Chr(34) & ")"))
            r = Round(r, 3)
            b = 1
            j = j + 1
            If j > n Then
                If c = 1 Then
                    re = re & s
                Else
                    re = re & r
                End If
                Exit Do
            End If
        End If
    Loop
    ShowFormula = re
End Function

Sub test()
    Dim t As Variant
    t = ShowFormula(Range("d26"))
    End Sub

3 插值查二维表函数

注意，必须先将所查数据排序，即竖向和横向是排序的，递增或递减，不能是无序的。规范所带表格肯定是排好序的，不必担心。

'20210717秦修改代码
Public Function chazhi2(ary As Range, x0, y0 As Variant)
    n = ary.Rows.Count '统计行数
    m = ary.Columns.Count '统计列数

    i = 2
    Do While x0 > ary.Cells(1, i).Value And i < m  'x0位于i-1与i列之间
        i = i + 1
    Loop

    j = 2
    Do While y0 > ary.Cells(j, 1).Value And j < n  'y0位于j-1与j行之间，原代码里这里用的是i<n
        j = j + 1
    Loop

    If i = 2 Then
        i = 3
    End If
    If j = 2 Then
        j = 3
    End If

    k1 = (x0 - ary.Cells(1, i - 1).Value) / (ary.Cells(1, i).Value - ary.Cells(1, i - 1).Value) '计算系数
    k2 = (y0 - ary.Cells(j - 1, 1).Value) / (ary.Cells(j, 1).Value - ary.Cells(j - 1, 1).Value)

    zhi1 = ary.Cells(j - 1, i - 1).Value + k1 * (ary.Cells(j - 1, i).Value - ary.Cells(j - 1, i - 1).Value) '先横向插值
    zhi2 = ary.Cells(j, i - 1).Value + k1 * (ary.Cells(j, i).Value - ary.Cells(j, i - 1).Value)

    chazhi2 = zhi1 + k2 * (zhi2 - zhi1) '再竖向插值
End Function
' 测试
Sub test()
    Dim t As Variant
    Sheets("3.堤防表格").Select
    t = chazhi2(Range("C86:M92"), 1, 0.011)
End Sub
'编者：wenguoli3
'完成后未检验
'请试用，如有问题请与我联系

4 插值查一维表

最好做成vba自定义函数。

Public Function chazhi(ary As Range, x0 As Variant)
    n = ary.Rows.Count '统计行数

    i = 1
    Do While x0 > ary.Cells(i, 1).Value 'x0位于i-1与i列之间
        i = i + 1
    Loop

    k1 = (x0 - ary.Cells(i - 1, 1).Value) / (ary.Cells(i, 1).Value - ary.Cells(i - 1, 1).Value) '计算系数
    chazhi = ary.Cells(i - 1, 2).Value + k1 * (ary.Cells(i, 2).Value - ary.Cells(i - 1, 2).Value) '先横向插值
End Function

'测试
Sub test()
    Dim t As Variant
    t = chazhi(Range("b2:c6"), 6)
End Sub

能用函数组合成公式的，尽量用公式，避免用VBA。
竖表一维插值：可以把公式写到VBA中，做成自定义函数，方便使用。
=OFFSET($A$2,MATCH(C3,$A$3:$A$28,1),1)+(C3-OFFSET($A$2,MATCH(C3,$A$3:$A$28,1),))/(OFFSET($A$2,MATCH(C3,$A$3:$A$28,1)+1,)-OFFSET($A$2,MATCH(C3,$A$3:$A$28,1),))*(OFFSET($A$2,MATCH(C3,$A$3:$A$28,1)+1,1)-OFFSET($A$2,MATCH(C3,$A$3:$A$28,1),1))

横表一维插值：

=OFFSET($A$1,1,MATCH(B3,$B$1:$AA$1,1))+(B3-OFFSET($A$1,0,MATCH(B3,$B$1:$AA$1,1)))/(OFFSET($A$1,0,MATCH(B3,$B$1:$AA$1,1)+1)-OFFSET($A$1,0,MATCH(B3,$B$1:$AA$1,1)))*(OFFSET($A$1,1,MATCH(B3,$B$1:$AA$1,1)+1)-OFFSET($A$1,1,MATCH(B3,$B$1:$AA$1,1)))

5 不定参数（变参数）的VBA函数方法

我们在使用一些函数的时候，里面的参数可以任意多个，是怎么做到的呢。以下是一个例子——分段计算管道水力学函数。

'局部水头损失系数 ∑ζ
'面积A   m2
'水力半径R   m
'流速V1  m/s
'谢才系数C = 1 / E7 * E11^(1 / 6)
'流量模数 K=E10*E12*E11^0.5
'单位长度水头损失 i2=10.67*E6^1.852/E25^1.852/E8^4.87

'使用不定数量的参数
'一般说来，过程调用中的参数个数应等于过程说明的参数个数。可用 ParamArray 关键字指明，
'过程将接受任意个数的参数。于是可以这样来编写计算总和的 Sum 函数：

Dim yita As Integer
Dim Q As Double
Dim L As Double
Dim N As Double
Dim DI As Double
Dim KESI As Double
Dim A As Double
Dim V As Double
Dim R As Double
Dim K As Double
Dim HF As Double
Dim HJ As Double
Dim intSums As Double

Function hydro(ParamArray intNums())
    yita = intNums(0)
    If yita = 1 Then '采用谢才系数公式，否则为海增威廉公式
        For i = 0 To UBound(intNums) - 1 Step 5

            Q = intNums(i + 1)
            L = intNums(i + 2)
            N = intNums(i + 3)
            DI = intNums(i + 4)
            KESI = intNums(i + 5)

            A = 3.1415926 * DI ^ 2 / 4
            V = Q / A
            R = DI / 4
            C = 1 / N * R ^ (1 / 6)
            K = A * C * R ^ 0.5
            '   沿程水损（含局部水损）
            HF = Q ^ 2 / K ^ 2 * L
                '局部水损
            HJ = KESI * V ^ 2 / 2 / 9.81
            hydro = hydro + HF + HJ
        Next 'i
    Else
        '海增威廉公式
    End If
'   For Each x In intNums
'      y = y + x
'   Next x
'   Sum1 = y
End Function

Private Sub test()
  B = hydro(1, 5, 100, 0.012, 2, 5, 2.5, 1000, 0.012, 1.6, 10)
End Sub

6 vlookup()和sumproduct()函数

前者用于单条件查询，必须先将所查数据排序，后者用于多条件复杂逻辑条件查询和计算：如果是“或”条件就相加，“且”条件就相乘。
=SUMPRODUCT((第1列满足第1条件)(第2区域满足第2条件)……(第n区域满足第n条件) 像这样的形式就是根据条件计数
=SUMPRODUCT((第1列满足第1条件)(第2区域满足第2条件)……(第n区域满足第n条件)*（某列区域）像这样的形式就是条件求和
能用函数的尽量用函数，避免用VBA。

7 单变量求解转换为循环迭代

以前有一些表格里求解方程用了“单变量求解”的方式，缺点是需要手动设置目标值。

首先记得打开excel的迭代求解
经过转变，可以用迭代来替代“单变量求解”
例如类似这样个方程：
0=7x^3+8x^2+9x+10
单变量求解的话，需要设置目标单元格为0，比如单元格A3输入7x^3+8x^2+9x+10，x代表A4单元格，那么A3单元格实际输入的是7*A4^3+8*A4^2+9*A4+10，单变量求解设定目标单元格A3，值为0，可变单元格为A4
为了避免这么麻烦的操作，可以这样：
将方程变化成x=-power((8x^2+9x+10)/7,1/3)
注意，一定要左边是x的一次方，右边所有x的指数必须小于一次方才能收敛。
这样，在A3单元格输入=-power((8*A3^2+9*A3+10)/7,1/3)，注意，是A3单元格和自己迭代计算，不需要A4单元格了。

8 国内外excel计算书网址

http://yakpol.net/index.html
http://www.engineering-international.com/
国内http://okok.org/