• [vba]excel中求选中数据和为给定数所有的组合


    昨天下午开始学习的vba,累死了,肯定有bug,待调试

    vba程序如下:

     1 Dim aSum As Integer
     2 Dim tSum As Integer
     3 Dim judge(30) As Integer
     4 Dim arrMax As Integer
     5 Dim arr
     6 Dim location(30) As Integer
     7 
     8 Function Test()
     9     Dim arrWmax As Integer
    10     Dim Rng As Range
    11     Dim beginRow As Integer
    12     Dim beginLine As Integer
    13     
    14     Set Rng = Application.InputBox(prompt:="Please Select....", Type:=8)
    15     rr = Rng.Address
    16     beginRow = Rng.Column
    17     beginLine = Rng.Row
    18     
    19     arr = Range(rr)
    20     aSum = 0
    21     arrMax = UBound(arr)
    22     arrWmax = UBound(arr, 2)
    23 
    24     For loca = 1 To arrMax
    25         location(loca) = beginLine
    26         beginLine = beginLine + 1
    27     Next
    28     
    29     For col = 2 To arrWmax  'modify
    30         tSum = arr(1, col)
    31         Call subTest(1, beginRow)
    32     Next
    33 
    34 End Function
    35 
    36 Function subTest(n As Integer, beginRow As Integer)
    37     If aSum > tSum Then
    38         Exit Function
    39     End If
    40 
    41     Dim i As Integer
    42     Dim j As Integer
    43     If aSum = tSum Then
    44         For i = 1 To n
    45             If judge(i) = 1 Then
    46                 Sheets(1).Cells(location(i), beginRow).Interior.Color = vbRed
    47             End If
    48         Next
    49 
    50         Exit Function
    51     End If
    52 
    53     If n = arrMax Then
    54         Exit Function
    55     End If
    56 
    57     For j = n To arrMax
    58         If judge(j) = 0 Then
    59             judge(j) = 1
    60             aSum = aSum + arr(j, 1)
    61             Call subTest(j, beginRow)
    62 
    63             judge(j) = 0
    64             aSum = aSum - arr(j, 1)
    65             If j < arrMax Then
    66                 While arr(j, 1) = arr(j + 1, 1)
    67                       j = j + 1
    68                 Wend
    69             End If
    70         End If
    71     Next
    72 
    73 End Function
  • 相关阅读:
    MogileFS的实现和bug解决
    MogileFS介绍
    SAMBA
    NFS
    测试DNS服务的命令
    DNS中的AC、rndc、智能DNS解析和基础排错
    DNS的主从、子域授权和转发服务器
    DNS域名记录
    DNS
    JavaScript设计模式与开发实践随笔(二)
  • 原文地址:https://www.cnblogs.com/hustcser/p/4353612.html
Copyright © 2020-2023  润新知