用VB实现矩阵的计算，满意给100

现有矩阵一，1   3   4  5    矩阵二：    4   -3  0    1
             1   3   3  4                3   -7  5    5
             1   1   2  3                -2   4  -15  0  
             8   7   1  ?                2   -4  5    1
1表示朝东，2，3，4，5，6，7，8依次为逆时针八向图，    7
6↖↑↗8     根据第一个矩阵的指向，计算第二个矩阵，如a（0，0）＝1，     
5←--→1     指向 a(0,1),则把  b（0，0）       
4↙↓↘2    加到b(0,1),赋值给b（0，1），计算完所有指向b（0,1）
   3        的值，如果b（0，1）<0，则赋值b(0,1)
             为0.比如计算到b（1，1）的时候，值为－2，就将b（1，1）赋值  为0，依此计算出b（3，3）的值为7。
    请教大家如何来用VB语言实现这一计算分析过程，我感觉要用到树的编程，有哪位高手愿意赐教吗，小女子将不甚感激！

解决方案 »

  1.   

    Google "VB Matrix"Matrix Operations Library
    http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=42477&lngWId=1
      

  2.   

    '结构体+2维数组Private Type poxy
      value As Double  'c1某位置上的数值
      x As Long
      y As Long '对应c2的x,y坐标
    End Type
    Private Sub Form_Click()
      Dim c1(3, 3) As poxy, c2(3, 3) As Double, x As Long, y As Long
      '这里自己添加初始化C1代码
      For x = 0 To 3
        For y = 0 To 3
          With c1(x, y)
            c2(.x, .y) = .value
          End With
        Next
      Next
      For y = 0 To 3
        For x = 0 To 3
          If c2(x, y) < 0 Then c2(x, y) = 0
          Print c2(x, y);
        Next
        Print
      Next
    End Sub
      

  3.   

    Private Type node
      son As Single
      father As Single
      son_row As Integer
       son_column As Integer
       father_row As Integer
       father_column As Integer
       layer As Integer
      End Type
      
    Dim a(3, 3) As Integer
    Dim b(3, 3) As Single
          
    Private Sub Command1_Click()
    Dim temp
    Dim i As Integer, j As Integer
    Dim tree(15) As node
    Dim result As SingleOpen "e:\3.txt" For Input As #1
    For i = 0 To 3
    For j = 0 To 3
     Input #1, temp
    a(i, j) = Val(temp)
    Next j
    Next i
    Close #1Open "e:\1.txt" For Input As #2
    For i = 0 To 3
    For j = 0 To 3
     Input #2, temp
    b(i, j) = Val(temp)
    Next j
    Next i
    Close #2
    Print a(1, 0); a(1, 1); a(1, 2); a(1, 3)
    Print b(1, 0); b(1, 1); b(1, 2); b(1, 3)'tree() = layersearch(a(0 to 3, 0 to 3), b(0 to 3, 0 to 3))
    'Print tree(0)
    For i = 0 To 15
     tree(i) = layersearch(a(), b())
     Next i
    result = calculate(tree(), b())
    'Print tree(0)
    Print result
    End SubPrivate Function layersearch(a() As Integer, b() As Single) As node
    Dim tree(15) As node     '定义一个新的一维结构数组
    Dim i As Integer
    Dim j As Integer
    Dim t As Integer     ' t为树的层数
    Dim s As Integer     's为新结构数组的下标tree(0).layer = 0
    tree(0).father = 0
    tree(0).son = b(3, 3)
    tree(0).son_row = 3
    tree(0).son_column = 3
    tree(0).father_column = 3
    tree(0).father_row = 3
    s = 1
    Do While i >= 0 And j >= 0
    i = 3
    j = 3
    'For i = 0 To 3
    'For j = 0 To 3
    Do While i >= 0 And j - 1 >= 0
    If a(i, j - 1) = 1 Then      '判断流向，根据流向判断存储为树的结果
    tree(s).layer = t
    tree(s).father = b(i, j)
    tree(s).son = b(i, j - 1)
    s = s + 1
    tree(s) = layersearch(a(), b())
    End If
    Loop
    j = j - 1
    i = i - 1
    LoopFor i = 0 To 3
    For j = 0 To 3Do While i - 1 >= 0 And j - 1 >= 0
    If a(i - 1, j - 1) = 2 Then
    tree(s).layer = t
    tree(s).father = b(i, j)
    tree(s).son = b(i - 1, j - 1)
    s = s + 1
    tree(s) = layersearch(a(), b())
    End If
    Loop
    Next j
    Next iFor i = 0 To 3
    For j = 0 To 3Do While i - 1 >= 0 And j >= 0
    If a(i - 1, j) = 4 Then
    tree(s).layer = t
    tree(s).father = b(i, j)
    tree(s).son = b(i - 1, j)
    s = s + 1
    tree(s) = layersearch(a(), b())     '此处提示有错
    End If
    Loop
    Next j
    Next iFor i = 0 To 3
    For j = 0 To 3
    Do While i - 1 >= 0 And j >= 0
    If a(i - 1, j + 1) = 8 Then
    tree(s).layer = t
    tree(s).father = b(i, j)
    tree(s).son = b(i - 1, j + 1)
    s = s + 1
    tree(s) = layersearch(a(), b())
    End If
    Loop
    Next j
    Next iFor i = 0 To 3
    For j = 0 To 3
    Do While i >= 0 And j >= 0
    If a(i, j + 1) = 16 Then
    tree(s).layer = t
    tree(s).father = b(i, j)
    tree(s).son = b(i, j + 1)
    s = s + 1
    tree(s) = layersearch(a(), b())
    End If
    Loop
    Next j
    Next iFor i = 0 To 3
    For j = 0 To 3
    Do While i >= 0 And j >= 0
    If a(i + 1, j + 1) = 32 Then
    tree(s).layer = t
    tree(s).father = b(i, j)
    tree(s).son = b(i + 1, j + 1)
    s = s + 1
    tree(s) = layersearch(a(), b())
    End If
    Loop
    Next j
    Next i
    For i = 0 To 3
    For j = 0 To 3
    Do While i >= 0 And j >= 0
    If a(i + 1, j) = 64 Then
    tree(s).layer = t
    tree(s).father = b(i, j)
    tree(s).son = b(i + 1, j)
    s = s + 1
    tree(s) = layersearch(a(), b())
    End If
    Loop
    Next j
    Next i
    For i = 0 To 3
    For j = 0 To 3Do While i >= 0 And j - 1 >= 0
    If a(i + 1, j - 1) = 128 Then
    tree(s).layer = t
    tree(s).father = b(j, j)
    tree(s).son = b(i + 1, j - 1)
    s = s + 1
    tree(s) = layersearch(a(), b())
    End If
    Loop
    Next j
    Next iEnd Function'根据结构体数组和源汇能力值数组，分析源汇值到沟口的产流数据
    Private Function calculate(tree() As node, b() As Single) As Single
    '调用layersearch函数
    Dim t As Integer
    Dim i As Integer
    Dim j As Integer
    'Dim result As Singlet = tree(UBound(tree())).layer
    Do While t >= 0For i = 0 To UBound(tree())
    If tree(i).layer = t And tree(i).father_row = tree(j).father_row And _
            tree(i).father_column = tree(j).father_column Then
    b(tree(i).father_row, tree(i).father_column) = b(tree(j).son_row, tree(j).son_column) + _
              b(tree(i).son_row, tree(i).son_column) + b(tree(i).father_row, tree(i).father_column)End If
    Next i
    t = t - 1
    Loop
    calculate = b(tree(0).father_row, tree(0).father_column)
    End Function这是我刚开始自己编的，程序提示溢出堆栈空间，请问怎样解决
      

  4.   

    你的代码重复的地方很多矩阵1的每一个元素 指向 矩阵2 1次性的 还是根据子节点 要求继续指向?还有你给的列子现有矩阵一，1   3   4  5    矩阵二：    4   -3  0    1
                 1   3   3  4                3   -7  5    5
                 1   1   2  3                -2   4  -15  0  
                 8   7   1  ?                2   -4  5    1
    1表示朝东，2，3，4，5，6，7，8依次为逆时针八向图，    7
    6↖↑↗8     根据第一个矩阵的指向，计算第二个矩阵，如a（0，0）＝1，     
    5←--→1     指向 a(0,1),则把  b（0，0）       
    4↙↓↘2    加到b(0,1),赋值给b（0，1），计算完所有指向b（0,1）
       3        的值，如果b（0，1）<0，则赋值b(0,1)既然第一个矩阵都是正的 不管怎么加 第二个矩阵 怎么有负数?
      

  5.   

    贴图我一般喜欢用 yahoo 相册 不过要先注册下
      

  6.   

    4 → -3   0 ← 1
         ↓ ↙
    3 → -7   5    5
         ↓   ↓ ↙
    -2 → 4 →-15  0  
      ↗ ↑      ↘↓
    2    -4    5 → 1就是这样的一个过程啦，先从b(3,3)开始，寻找其相邻的点是否指向b(3,3)，指向的话将该相邻点看成是b(3,3)的儿子节点，并且赋予为第一代，搜索完其相邻节点后，再根据同样的方法判断其儿子节点，赋予第二代，以此类推。比如b(3,2)，b(2,2)，b(2,3)就是b(3,3)的第一代，b(1,2)，b(1,3)，b(2,1)是b(2,2)的下一代，所以是b(3,3)的第二代。b(3,2)，b(2,3)没有下一代。
    就是这个搜索的过程我有点迷糊了，所以搜索层这个函数写的有点乱。刚开始的自定义变量只存储b矩阵元素的数值，后来发现不行，又加上了字节点和父节点的行列信息。   7
    6↖↑↗8         
    5←--→1           
    4↙↓↘2    
       3
      

  7.   

    给你一个思路：
    1 首先将 a, b 线性化  a:   b:
    1 :1   4
    2 :3  -3
    3 :4   0
    4 :5   1
    5 :1   3
    6 :3  -7
    7 :3   5
    8 :4   5
    9 :1  -2
    10:1   4
    11:2 -15
    12:3   0
    13:8   2
    14:7  -4
    15:1   5
    16:0   12 a 不要存什么方向代码，而是具体的单元号。可以通过查一个表来进行转换：
    假定不可越界跳转
    1: 1->2, 2->6, 3->5
    2: 1->3, 2->7, 3->6, 4->5, 5->1
    3: 1->4, 2->8, 3->7, 4->6, 5->2
    4: 3->8, 4->7, 5->6
    5: 1->6, 2->10,3->9, 7->1, 8->2
    .....余类推，自己写一下。（0 就填写本格序号）3 这样你就得到了一张表，a 列是指向地址，b 列是值。你按某种规则逐行计算即可。
    例如，你首先计算第 16 行，只要查出所有指向 16 行的值累加即可。记住，图仅仅帮助你理解需求，真正的算法要灵活运用你的计算机知识，使之适合计算机处理。
      

  8.   

    另，方向码转换成行地址，也可以将方向码变成一个加数（偏移量）：1 -> 1
    2 -> 5
    3 -> 4
    4 -> 3
    5 -> -1
    6 -> -5
    7 -> -4
    8 -> -3用本格的地址，加上偏移量，就是新的指向地址。
    这样得到的表是：
      a:   b:
    1 :2   4
    2 :6  -3
    3 :6   0
    4 :6   1
    5 :6   3
    6 :10 -7
    7 :11  5
    8 :11  5
    9 :10 -2
    10:11  4
    11:16 -15
    12:16  0
    13:10  2
    14:10  -4
    15:16  5
    16:0   1BTW, 你是“免费苹果”或是“没有苹果之忧”。
      

  9.   

    有点不懂哦，就是你说的这些：
    a 不要存什么方向代码，而是具体的单元号。可以通过查一个表来进行转换：
    假定不可越界跳转
    1: 1->2, 2->6, 3->5
    2: 1->3, 2->7, 3->6, 4->5, 5->1
    3: 1->4, 2->8, 3->7, 4->6, 5->2
    4: 3->8, 4->7, 5->6
    5: 1->6, 2->10,3->9, 7->1, 8->2          “尤其是这里啦”
    .....余类推，自己写一下。（0 就填写本格序号）3 这样你就得到了一张表，a 列是指向地址，b 列是值。你按某种规则逐行计算即可。
    例如，你首先计算第 16 行，只要查出所有指向 16 行的值累加即可。怎么一会是“逐行计算”一会是“又要累加”啊你把我弄得更迷糊了，你这样计算的话就更复杂啦
      

  10.   

    我原来的假设是，你很聪明，但缺乏足够的计算机思维的训练，所以写得很简略。对不起，现在从头细说。1 为什么线性化
    在计算机中，内存是线性存在的。无论多么复杂的空间问题，都要线性化以适应计算机的处理。你的所谓“矩阵”表（你的问题实际上与矩阵数学毫无关系），实际上是两个关联的二维表，a是地址表示，b是值。线性化的目的，就是把它们变成普通的线性表。而线性化最终的目的，要把你对网格单元的二维标签，变为一维的索引。实际上，多维数组在计算机内存中，还是线性排列的。在你的问题中，多维信息并没有实际意义。具体到你的 4X4 网格（我不较它矩阵），可以从左至右，从上到下编号为1 -16（当然也可以是0 - 15）。如果你愿意先从上至下也可以，甚至逆向编号。总之，使你的运算规则执行起来最方便。2 为什么要做方向代码到单元格索引的转换
    你的方向码的目的，是建立两个单元格之间的联系，它最终是指向另一个单元格的。所以最直接的方式，就是在源单元格中写入目标单元格的索引号（地址）。在计算机处理中，只有两类数，地址和值。你的方向码最终还是要变成地址的。所以给你一个更明确的方法，事先转换，后面的计算就更清晰了。不知你懂了没有。写代码看看吧：
    Dim Index(0 To 15) As Integer, Values(0 To 15) As Integer'线性化
    For i = 0 To 3     'Row
       For j = 0 To 3  'Col
          Index(i * 4 + j) = a(i, j)
          Values(i * 4 + j) = b(i, j)
       Next j
    Next i
    '方向码-地址变换
    '本来可以在上一个双重循环中一并完成
    '为了你能看懂，还是拆开了
    For i = 0 To 15
       Select Case Index(i)
          Case 0
             Index(i) = i
          Case 1 '向右
             Index(i) = i + 1
          Case 2 '右下
             Index(i) = i + 5
          Case 3 '向下
             Index(i) = i + 4
          Case 4 '左下
             Index(i) = i + 3
          Case 5 '向左
             Index(i) = i - 1
          Case 6 '左上
             Index(i) = i - 5
          Case 7 '向上
             Index(i) = i - 4
          Case 8 '右上
             Index(i) = i - 3
    Next i
    '计算
    '没太看懂你的计算规则说明，姑妄写之
    For i = 0 To 15
      For j = 0 To 15
         If Index(j) = i And i <> j Then
            Value(i) = Value(i) + Value(j)
         End If
      Next j
      If Value(i) < 0 Then Value(i) = 0
    Next i也许你认为这样的转换没有什么意义。如果你的网格是 2X2 的，的确如此，但如果是 10000X10000 的网格，你就看到它的好处了。
      

  11.   

    你过奖了，没有你聪明啦。谢谢你，我的网格就有你说的那么大哦。
    我先是拿一个小的网格进行实验。
    我懂了你的程序，不过感觉那个计算过程不是我所说的。
    根据你的程序分析：value（0）＝value（0）＋value（15）
                      value（2）＝value（0）＋value（2）我要计算的过程是这样的：4 → -3   0 ← 1
         ↓ ↙
    3 → -7   5    5
         ↓   ↓ ↙
    -2 → 4 →-15  0  
      ↗ ↑      ↘↓
    2    -4    5 → 1就是照着这个指向计算，b（0，0）＋b（0，1）=b（0，1）,4＋（－3）＝1,
    这样b（0，1)=1   b（0，3）＋b（0，2）＝b（0，2），1＋0＝1
    这样b（0，2）＝1 b（1，0）+b（0，1）+b（0，2）+b（1，1）=b（1，1），1＋1＋3＋（-7）＝－2
    （－2）<0,所以b（1，1）＝0b（2，0）＝－2，所以b（2，0）＝0，b(3,1)也是如此。如此计算直到根节点处b（2，2）+b（2，3）+b（3，2）+b（3，3）=b（3，3）计算结果为7
      

  12.   

    value（0）＝value（0）＋value（15）
    value（2）＝value（0）＋value（2） ‘这里我下标搞错了，应该是value（1）＝value（0）＋value（1）
    你不是从根节点算起的吧。
      

  13.   

    '现有矩阵一，1   3   4  5    矩阵二：    4   -3  0    1
    '            1   3   3  4                3   -7  5    5
    '            1   1   2  3                -2   4  -15  0
    '            8   7   1  ?                2   -4  5    1Private Function calcb(a() As Byte, b() As Long) As Long()
      '确定数组长度
      Dim bc As Long
      bc = UBound(b)
      '定义方向数组
      Dim a_b(8) As Integer
      '初始化 9个方向 0~8 作用于数组中的相对位置,注 方向0代表指向自己 或者说没有父结点
      a_b(6) = -5: a_b(7) = -4: a_b(8) = -3
      a_b(5) = -1: a_b(0) = 0:  a_b(1) = 1
      a_b(4) = 3:  a_b(3) = 4:  a_b(2) = 5
      'bsp 数组代表某个节点拥有儿子结点状况,bcd数组代表某个结点是否被计算过
      Dim bsp() As Byte, bcd() As Boolean, c() As Long
      c = b
      ReDim bsp(bc), bcd(bc)
      '初始化 结点状态
      Dim i As Long, t As Long, Stoploop As Boolean
      For i = 0 To bc
        t = a(i)
        If t > 0 Then t = 2 ^ (t - 1) Else t = 0
        bsp(i + a_b(a(i))) = bsp(i + a_b(a(i))) Or t  '累计儿子结点状况 最多8个 即当bsp(i)=255 或者 11111111(二进制)
      Next i
      '开始正式转换
      Do
        Stoploop = True
        For i = 0 To bc
          If Not bcd(i) Then '判断是否计算过
            If bsp(i) = 0 Then '判断结点是否是根结点
              If c(i) < 0 Then c(i) = 0 '处理小于0的
              bcd(i) = True
              t = a(i)
              If t > 0 Then
                t = 2 ^ (t - 1)
                c(i + a_b(a(i))) = c(i + a_b(a(i))) + c(i)
                bsp(i + a_b(a(i))) = bsp(i + a_b(a(i))) Xor t
              End If
              Stoploop = False
            End If
          End If
        Next i
      Loop Until Stoploop
      calcb = c()
    End FunctionPrivate Sub Command1_Click()
      Dim a() As Byte, b() As Long, c() As Long
      '初始化数组,我这里就直接调用你提供的数据,不从文件读取了
      ReDim a(15), b(15)
      a(0) = 1: a(1) = 3: a(2) = 4: a(3) = 5
      a(4) = 1: a(5) = 3: a(6) = 3: a(7) = 4
      a(8) = 1: a(9) = 1: a(10) = 2: a(11) = 3
      a(12) = 8: a(13) = 7: a(14) = 1: a(15) = 0
      
      b(0) = 4: b(1) = -3: b(2) = 0: b(3) = 1
      b(4) = 3: b(5) = -7: b(6) = 5: b(7) = 5
      b(8) = -2: b(9) = 4: b(10) = -15: b(11) = 0
      b(12) = 2: b(13) = -4: b(14) = 5: b(15) = 1
      
      c = calcb(a(), b())
      For i = 0 To UBound(c)
        Debug.Print c(i);
        If i Mod 4 = 3 Then Debug.Print
      Next i
      
    End Sub
    '输出结果为
     4  1  1  1 
     3  0  5  5 
     0  6  1  0 
     2  0  5  7
      

  14.   

    LZ开始的问题与后面的是有出入的 所以要看懂LZ的问题 还是看他后面的说明---------------我是分割线---------------
    我要计算的过程是这样的：4 → -3   0 ← 1
         ↓ ↙
    3 → -7   5    5
         ↓   ↓ ↙
    -2 → 4 →-15  0  
      ↗ ↑      ↘↓
    2    -4    5 → 1就是照着这个指向计算，b（0，0）＋b（0，1）=b（0，1）,4＋（－3）＝1,
    这样b（0，1)=1   b（0，3）＋b（0，2）＝b（0，2），1＋0＝1
    这样b（0，2）＝1 b（1，0）+b（0，1）+b（0，2）+b（1，1）=b（1，1），1＋1＋3＋（-7）＝－2
    （－2）<0,所以b（1，1）＝0b（2，0）＝－2，所以b（2，0）＝0，b(3,1)也是如此。如此计算直到根节点处b（2，2）+b（2，3）+b（3，2）+b（3，3）=b（3，3）计算结果为7
      

  15.   

    你真的很厉害啊
    运行结果确实是这样的
    但是我把矩阵扩大一下怎么就不行了，你帮我看看我该的地方对不对
    我就是将两矩阵多加了一行
    4 → -3   0 ← 1
         ↓ ↙
    3 → -7   5    5
         ↓   ↓ ↙
    -2 → 4 →-15  0  
      ↗ ↑      ↘↓
    2    -4    5 → 1
    ↑             ↓
    -1 ← 3     2 →1
    改动代码的地方：
     ReDim a(19), b(19)
    ..........‘代码不变
    a(15) = 3
       a(16) = 7: a(17) = 5: a(18) = 1: a(19) = 0
    ...............................’不变
       b(16) = -1: b(17) = 3: b(18) = 2: b(19) = 1怎么运行起来什么结果也没有啊
    麻烦小刀惋心帮我看看，是不是还有什么地方要改
      

  16.   

    Private Function calcb(a() As Byte, b() As Long) As Long()
      '确定数组长度
      Dim bc As Long
      bc = UBound(b)
      '定义方向数组
      Dim a_b(8) As Integer
      '初始化 9个方向 0~8 作用于数组中的相对位置,注 方向0代表指向自己 或者说没有父结点
      a_b(6) = -5: a_b(7) = -4: a_b(8) = -3
      a_b(5) = -1: a_b(0) = 0:  a_b(1) = 1
      a_b(4) = 3:  a_b(3) = 4:  a_b(2) = 5
      'bsp 数组代表某个节点拥有儿子结点状况,bcd数组代表某个结点是否被计算过
      Dim bsp() As Byte, bcd() As Boolean, c() As Long
      c = b
      ReDim bsp(bc), bcd(bc)
      '初始化 结点状态
      Dim i As Long, t As Long, Stoploop As Boolean
      For i = 0 To bc
        t = a(i)
        If t > 0 Then t = 2 ^ (t - 1) Else t = 0
        bsp(i + a_b(a(i))) = bsp(i + a_b(a(i))) Or t  '累计儿子结点状况 最多8个 即当bsp(i)=255 或者 11111111(二进制)
      Next i
      '开始正式转换
      Do
        Stoploop = True
        For i = 0 To bc
          If Not bcd(i) Then '判断是否计算过
            If bsp(i) = 0 Then '判断结点是否是根结点
              If c(i) < 0 Then c(i) = 0 '处理小于0的
              bcd(i) = True
              t = a(i)
              If t > 0 Then
                t = 2 ^ (t - 1)
                c(i + a_b(a(i))) = c(i + a_b(a(i))) + c(i)
                bsp(i + a_b(a(i))) = bsp(i + a_b(a(i))) Xor t
              End If
              Stoploop = False
            End If
          End If
        Next i
      Loop Until Stoploop
      calcb = c()
    End FunctionPrivate Sub Command1_Click()
      Dim a() As Byte, b() As Long, c() As Long
      '初始化数组,我这里就直接调用你提供的数据,不从文件读取了
      ReDim a(19), b(19)
      a(0) = 1: a(1) = 3: a(2) = 4: a(3) = 5
      a(4) = 1: a(5) = 3: a(6) = 3: a(7) = 4
      a(8) = 1: a(9) = 1: a(10) = 2: a(11) = 3
      a(12) = 8: a(13) = 7: a(14) = 1: a(15) = 3
      a(16) = 7: a(17) = 5: a(18) = 1: a(19) = 0
      
      b(0) = 4: b(1) = -3: b(2) = 0: b(3) = 1
      b(4) = 3: b(5) = -7: b(6) = 5: b(7) = 5
      b(8) = -2: b(9) = 4: b(10) = -15: b(11) = 0
      b(12) = 2: b(13) = -4: b(14) = 5: b(15) = 3
      b(16) = -1: b(17) = 3: b(18) = 2: b(19) = 1
      
      c = calcb(a(), b())
      For i = 0 To UBound(c)
        Debug.Print c(i);
        If i Mod 4 = 3 Then Debug.Print
      Next i
      
    End Sub输出结果:
     4  1  1  1 
     3  0  5  5 
     0  8  3  0 
     4  0  5  11 
     2  3  2  14
    不知道你的具体代码是怎样改的
      

  17.   

    Stoploop = False位置变动下-------------------------------------------
              If t > 0 Then
                t = 2 ^ (t - 1)
                c(i + a_b(a(i))) = c(i + a_b(a(i))) + c(i)
                bsp(i + a_b(a(i))) = bsp(i + a_b(a(i))) Xor t
                Stoploop = False
              End If这样更符合逻辑,要不会多循环1次for
      

  18.   

    是的，结果是正确的，想问一下，以下过程该如何修改呢？
             -3    
             ↓ 
        3 → -7    5      
             ↓    ↓
             4 → -15   0  
          ↗ ↑      ↘↓
         2    -4    5 →1
        ↑              ↓
        -1              1
    计算规则是一样的，而且矩阵存储是这样的现有指向矩阵a， 
    -9999      3      4  -9999   
        1      3      3  -9999             
    -9999      1      2     3       
        8      7      1     3
        7   -9999   -9999   0
    能力值矩阵b
    -9999    -3  -9999   -9999
       3     -7      5   -9999
    -9999     4    -15       0
       2     -4      5       1
    -1    -9999  -9999       1就是说-9999表示的是空数据，相当于null，不需要处理。
    不管是a还是b矩阵里面只要对应的元素是-9999，这个元素就不用管它，最终值还是-9999
             -3    
             ↓ 
        3 → -7    5      
             ↓    ↓
             4 → -15   0  
          ↗ ↑      ↘↓
         2    -4    5 →1
        ↑              ↓
        -1              1
    请问这个过程该怎么改动一下呢
      
      

  19.   

    呵呵 你的问题还越变越通用化 其实你一次把问题描述清楚多好再次帮你修改了下 天这么热 那天遇上你 拉你请吃冰哦
    '-9999      3      4  -9999
    '    1      3      3  -9999
    '-9999      1      2     3
    '    8      7      1     3
    '    7   -9999   -9999   0'
    '能力值矩阵b
    '-9999    -3  -9999   -9999
    '   3     -7      5   -9999
    '-9999     4    -15       0
    '   2     -4      5       1
    '-1    -9999  -9999       1
    Private Function calcb(a() As Long, b() As Long) As Long()
      '确定数组长度
      Dim bc As Long
      bc = UBound(b)
      '定义方向数组
      Dim a_b(8) As Integer
      '初始化 9个方向 0~8 作用于数组中的相对位置,注 方向0代表指向自己 或者说没有父结点
      a_b(6) = -5: a_b(7) = -4: a_b(8) = -3
      a_b(5) = -1: a_b(0) = 0:  a_b(1) = 1
      a_b(4) = 3:  a_b(3) = 4:  a_b(2) = 5
      'bsp 数组代表某个节点拥有儿子结点状况,bcd数组代表某个结点是否被计算过
      Dim bsp() As Byte, bcd() As Boolean, c() As Long
      c = b
      ReDim bsp(bc), bcd(bc)
      '初始化 结点状态
      Dim i As Long, t As Long, Stoploop As Boolean
      For i = 0 To bc
        t = a(i)
        If t > 0 And (c(i) <> -9999) Then
          t = 2 ^ (t - 1)
          bsp(i + a_b(a(i))) = bsp(i + a_b(a(i))) Or t  '累计儿子结点状况 最多8个 即当bsp(i)=255 或者 11111111(二进制)
        End If
      Next i
      '开始正式转换
      Do
        Stoploop = True
        For i = 0 To bc
          If Not bcd(i) And (c(i) <> -9999) Then '判断是否计算过
            If bsp(i) = 0 Then '判断结点是否是根结点
              If c(i) < 0 Then c(i) = 0 '处理小于0的
              bcd(i) = True
              t = a(i)
              If t > 0 Then
                t = 2 ^ (t - 1)
                c(i + a_b(a(i))) = c(i + a_b(a(i))) + c(i)
                bsp(i + a_b(a(i))) = bsp(i + a_b(a(i))) Xor t
                Stoploop = False
              End If
            End If
          End If
        Next i
        Print
      Loop Until Stoploop
      calcb = c()
    End FunctionPrivate Sub Command1_Click()
      Dim a() As Long, b() As Long, c() As Long
      '初始化数组,我这里就直接调用你提供的数据,不从文件读取了
      ReDim a(19), b(19)
      a(0) = -9999: a(1) = 3: a(2) = 4: a(3) = -9999
      a(4) = 1: a(5) = 3: a(6) = 3: a(7) = -9999
      a(8) = -9999: a(9) = 1: a(10) = 2: a(11) = 3
      a(12) = 8: a(13) = 7: a(14) = 1: a(15) = 3
      a(16) = 7: a(17) = -9999: a(18) = -9999: a(19) = 0
      
      b(0) = -9999: b(1) = -3: b(2) = -9999: b(3) = -9999
      b(4) = 3: b(5) = -7: b(6) = 5: b(7) = -9999
      b(8) = -9999: b(9) = 4: b(10) = -15: b(11) = 0
      b(12) = 2: b(13) = -4: b(14) = 5: b(15) = 1
      b(16) = -1: b(17) = -9999: b(18) = -9999: b(19) = 1
      
      c = calcb(a(), b())
      For i = 0 To UBound(c)
        Debug.Print c(i),
        If i Mod 4 = 3 Then Debug.Print
      Next i
      
    End Sub输出结果-9999          0            -9999         -9999         
     3             0             5            -9999         
    -9999          6             0             0            
     2             0             5             6            
     0            -9999         -9999          7            
      

  20.   

    呵呵,吃住都没问题.再问你一下,不要嫌我烦哦.
    就是你把以下这两个数据改一下
    a(2) = -9999: 
     b(2) = 2: 
    就是a如果是null,结果c(2)=-9999,你程序的结果是2.不过后面的计算结果还是正确的.
    想问一下怎么改可以实现.还是要麻烦一下你.
      

  21.   

    我这里c(2)还是2啊a(x) 和b(x) 只要有1个是 -9999 那么c(x)=b(x) 一直不变的
      

  22.   

    看错了 你要求只要其中1个是-9999 c(x)=-9999在 
      If c(i) < 0 Then c(i) = 0 '处理小于0的 
    后面加1句
      If a(i) = -9999 Then c(i) = -9999
      

  23.   

    如果方向的值是用1 2 4 8 16 32 64 128表示，是不是不好改啊。
    也就是矩阵中1 2 4 8 16 32 64 128分别代替1 2 3 4 5 6 7 8 ，
    我才发现前期分析出来txt文件结果是用1 2 4 8 16 32 64 128表示的。
      

  24.   

    我在读取的时候将数据改变就可以了。
    想问一下，我要将c数组写到txt文件中去。
     Open "e:\2.txt" For Output As #3
      For i = 0 To UBound(c)
        Print #3, c(i)
    Next i
    Close #3
    结果是每输出一个值就换行。
    请问怎么改可以以空格隔开数据，而不是换行。
      

  25.   

    我的代码确实是把1,2,3,4,5,6,7,8 转化成1,2,4,8.. 处理的
    第2个问题 
    -----Print #3, c(i);
    就是后面加个分号 ";"
      

  26.   

    如果数据很多的话，不止一行，数据会自动换行吧。
    还有如果我是追加数据，就是不破坏txt里面的数据，就是在后面追加数据，
    怎么改啊。
      

  27.   

    追加那就Open "e:\2.txt" For Append As #3 方式打开
      

  28.   

    想写入以下到txt
    ncols         4
    nrows         4
    NODATA_value  -9999
    代码提示错误，
    缺少; 行号或标签或语句或语句结束
     Open "e:\2.txt" For Output As #3
       Print #3, "ncols"; Tab(14); ncols
      print #3, "nrows": Tab(14): nrows       ‘此处出错
       print #3, "NODATA_value"; Tab(10): -9999   ’此处出错
    不明白怎么回事，该怎么改啊
      

  29.   

    还有一个问题
    如何从文件的某行开始读和开始写数据呢
    Open "e:\1.txt" For Input As #2
    For i = 0 To UBound(b())
     Input #2, temp
    b(i) = Val(temp)
    Next i
    Close #2这是读，该怎么改啊写文件
    Open "e:\2.txt" For Output As #3
        For i = 0 To UBound(c)
          Print #3, c(i);
      Next i
      Close #3
    还有怎么将一个文件的前几行复制给另一文件的前几行啊
      

  30.   

    '第一个问题需要用split函数来分割
    Private Sub Command1_Click()
      Dim filet() As Byte, filelen As Long, strt() As String, i As Long
      Open "e:\1.txt" For Binary As #1
      filelen = LOF(1)
      ReDim filet(filelen - 1)
      Get #1, , filet
      filet = StrConv(filet, vbUnicode)
      strt = Split(filet, vbCrLf)
      '然后假如说你从第3行开始取值给b
      For x = 2 To UBound(strt)
        b(x - 2) = strt(x)
      Next
    End Sub第二个 问题 我也没有什么好办法 就用最原始的方法
    其实文件增加内容 一般都是追加方式,你要不断的把增加的内容放在文件起始位置是很不合理的
    给你个简单的列子
    假如说要把某几行数据 放到2.txt文件起始位置
    Private Sub Command1_Click()
      Dim c(15) As Long
      c(0) = 12
      c(1) = 14
      c(2) = 13
      Dim filet() As Byte, filel As Long, strt As String, i As Long
      Open "e:\1.txt" For Binary As #1
      filel = LOF(1)
      ReDim filet(filel - 1)
      Get #1, 1, filet
      Put #1, 1, CStr(c(0)) & vbCrLf
      Put #1, , CStr(c(1)) & vbCrLf
      Put #1, , CStr(c(2)) & vbCrLf
      Put #1, , filet
      Close #1
    End Sub
      

  31.   

    大家帮忙写一个EXCEL宏。条件是这样的：要在EXCEL里面查找数据。如：找13104567 但是我的EXCEL里面有可能没有这个数，但一个格子里面有这样的数：13101234-2345 3456-5678 6789-8974等等，找的就是这个格子。 所以先判断前四位，再看后四位数是否在里面的二个数之间，注意：数也不是连续，第一个数的前四位要与我要找的数的前四位相同！ 有人能解决这个问题吗？
      

  32.   

    我想生成exe文件，但是读取文件的路径和文件名已经规定了。
    想问一下，如果选择硬盘中存在的某个文件要用什么控件，
    还有生成的文件如何来选择存放目录，用什么空间。
      

  33.   

    部件里面添加commanddialog 控件
      

  34.   

    第一个程序从某行开始读数据
      b(x - 6) = strt(x) 提示类型不匹配
    是什么问题啊
    还有第二个程序将一个文件的前几行复制给另一文件的前几行
    你怎么只对一个文件进行操作啊。
    是这样，我要将一个txt文件的前6行（如下）复制给另一文件的前6行
    ncols         2200
    nrows         3326
    xllcorner     469198.3496348
    yllcorner     3439351.7261882
    cellsize      2
    NODATA_value  -9999
      

  35.   

    ~~你的基础实在很薄弱，我的代码只是给你参考文件操作方法
    还是给你写个完整的
    假如 把1.txt 前6行 添加到 2.txt 最前面Private Sub Command1_Click()
      Dim stra As String, strt As String, filetmp() As Byte, fileln As Long
      Open "e:\1.txt" For Input As #1
      Open "e:\2.txt" For Binary As #2
      For x = 1 To 6
        Line Input #1, stra
        strt = strt & stra & vbCrLf
      Next
      Print strt
      fileln = LOF(2)
      ReDim filetmp(fileln - 1)
      Get #2, 1, filetmp
      Put #2, 1, strt
      Put #2, , filetmp
      Close #1
      Close #2
    End Sub
      

  36.   

    还是有下标越界
    出错行：ReDim filetmp(fileln - 1)
      

  37.   

    如果2.txt文件有内容的话，不出错
    如果2.txt为空的话才有下标越界
    出错行：ReDim filetmp(fileln - 1)
      

  38.   

    你是"e:\2.txt"不是个空文件吧！
      

  39.   

    fileln = LOF(2)
    if fileln>0 then ReDim filetmp(fileln - 1)
      

  40.   

    Private Sub Command1_Click()
      Dim stra As String, strt As String, filetmp() As Byte, fileln As Long
      Open "e:\1.txt" For Input As #1
      Open "e:\2.txt" For Binary As #2
      For x = 1 To 6
        Line Input #1, stra
        strt = strt & stra & vbCrLf
      Next
      Print strt
      fileln = LOF(2)
      If fileln > 0 Then
        ReDim filetmp(fileln - 1)
        Get #2, 1, filetmp
      End If
      Put #2, 1, strt
      If fileln > 0 Then
        Put #2, , filetmp
      End If
      Close #1
      Close #2
    End Sub
      

  41.   

    Private Sub Command1_Click()
      Dim filet() As Byte, filelen As Long, strt() As String, i As Long
      Dim b(15) As Long
      Open "e:\1.txt" For Binary As #1
      filelen = LOF(1)
      ReDim filet(filelen - 1)
      Get #1, , filet
      filet = StrConv(filet, vbUnicode)
      strt = Split(filet, vbCrLf)
      '然后假如说你从第7行开始取值给b
      For x = 6 To UBound(strt)
        b(x - 6) = Val(strt(x))
        Debug.Print b(x - 6)
      Next
    End Sub这个怎么只输出一个数4呢，是不是程序是读取字符串的，而不是数据的
    如果将  Dim b(15) As Long 改成string型的话
    则输出一串。
    4 -3 0 1 3 -7 5 5 -2 4 -15 0 2 -4 5 1 
      

  42.   

    因为读取的是一整行 并不是1行中的 一个数啊
    你要把每一行再1次用split 1行中分割数据 成你要的b数组
      

  43.   

    这样整行读取会不会有个问题，就是一个数据在一行的末尾未完，在第二行才完。
    刚学没多久，所以很多问题到运行起来才发现
    Private Sub Command1_Click()
      Dim filet() As Byte, filelen As Long, strt() As String, i As Long
      Dim b(2) As String
      Dim data() As String, a() As Long
      Dim n As Long
      Open "e:\1.txt" For Binary As #1
      filelen = LOF(1)
      ReDim filet(filelen - 1)
      Get #1, , filet
      filet = StrConv(filet, vbUnicode)
      strt = Split(filet, vbCrLf)
      '然后假如说你从第7行开始取值给b
      n = 0
      For x = 6 To UBound(strt)
        b(x - 6) = strt(x)
        'Debug.Print b(x - 6)
        data = Split(b(x - 6), "")
        
        For i = 0 To UBound(data)
         a(n) = Val(data(i))       -------a(n)下标越界怎么改啊
         n = n + 1
       Print data(i)
        Next i
      Next
    End Sub
      

  44.   

    这样整行读取会不会有个问题，就是一个数据在一行的末尾未完，在第二行才完。
    刚学没多久，所以很多问题到运行起来才发现
    Private Sub Command1_Click()
      Dim filet() As Byte, filelen As Long, strt() As String, i As Long
      Dim b(2) As String
      Dim data() As String, a() As Long
      Dim n As Long
      Open "e:\1.txt" For Binary As #1
      filelen = LOF(1)
      ReDim filet(filelen - 1)
      Get #1, , filet
      filet = StrConv(filet, vbUnicode)
      strt = Split(filet, vbCrLf)
      '然后假如说你从第7行开始取值给b
      n = 0
      For x = 6 To UBound(strt)
        b(x - 6) = strt(x)
        'Debug.Print b(x - 6)
        data = Split(b(x - 6), "")
        
        For i = 0 To UBound(data)
         a(n) = Val(data(i))       -------a(n)下标越界怎么改啊
         n = n + 1
       Print data(i)
        Next i
      Next
    End Sub
      

  45.   

    唉！a是动态数组，要redimredim a(ubound(data))
    For i = 0 To UBound(data)
    a(n) = Val(data(i)) -------a(n)下标越界怎么改啊
    n = n + 1
    Print data(i)
    Next i
      

  46.   

    还是不行啊，
    就是改变一下redim a(ubound(data))吗？
      

  47.   

    data = Split(b(x - 6))
    redim a(ubound(data))
      

  48.   

    还是下标越界啊
    Private Sub Command1_Click()
      Dim filet() As Byte, filelen As Long, strt() As String, i As Long
      Dim b(2) As String
      Dim data() As String, a() As Long
      Dim n As Long
      Open "e:\3.txt" For Binary As #1
      filelen = LOF(1)
      ReDim filet(filelen - 1)
      Get #1, , filet
      filet = StrConv(filet, vbUnicode)
      strt = Split(filet, vbCrLf)
      '然后假如说你从第7行开始取值给b
      n = 0
      For x = 6 To UBound(strt)
        b(x - 6) = strt(x)
        'Debug.Print b(x - 6)
        data = Split(b(x - 6), "")
         ReDim a(UBound(data))
        For i = 0 To UBound(data)
         a(n) = Val(data(i))-------错误行
         n = n + 1
         Print a(i)
        Next i
      Next
    End Sub你的redim a(ubound(data))是放在哪里
    我的a数组是不只存储一行的数据
      

  49.   

    For x = 6 To UBound(strt)
        b(x - 6) = strt(x)
        'Debug.Print b(x - 6)
        data = Split(b(x - 6), "")
    if x=6 then     
     ReDim a(UBound(data))
    else
     redim preserve a(ubound(date)+ubound(a)+1)
    endif
        For i = 0 To UBound(data)
         a(n) = Val(data(i))
         n = n + 1
         Print a(i)
        Next i
      Next
      

  50.   

    按你的思路
         Print a(i)
    也改为 print a(n) 好了
      

  51.   

    应该是print a(n)的
    我的思路是存储完一行的数据后接着存储下一行的数据
    所以另外设了一个变量
    不知道为什么
    老提示下标越界
      

  52.   

    redim preserve a(ubound(date)+ubound(a)+1)
    这个语句怎么红色显示啊
      

  53.   

    将txt的属性值依次赋给矩阵【4.3】，在用算法算出最值输出到窗体上，“开始”用callback把控件的值和算法程序连接，
    乘法运算代码之二 ---- 计算阶段代码
    i = 1: n = 1
    For i = 1 To 3
    Picture3.Print
    For n = 1 To 2
    c(i, n) = d(i) * e(n)
    Picture3.Print c(i, n) & " ";
    Next n
    n = 1
    Next i
    End Sub 
    “清除”即把窗体的值复为“”，“退出”在退出.click事件代码中添加end就可以.. 
      

  54.   

    乘法运算代码之二 ---- 计算阶段代码
    i = 1: n = 1
    For i = 1 To 3
    Picture3.Print
    For n = 1 To 2
    c(i, n) = d(i) * e(n)
    Picture3.Print c(i, n) & " ";
    Next n
    n = 1
    Next i
    End Sub 输入矩阵b代码
    Public Sub Command2_Click()
    Picture2.Cls
    For m = 1 To 2
    Picture2.Print
    For n = 1 To 2
    b(m, n) = Val(InputBox("输入b（" & m & "，" & n & "）", "输入数组b"))
    Picture2.Print b(m, n) & " ";
    Next n
    Next m
    End Sub 进行乘法运算代码之一 —— 预处理
    Private Sub Command3_Click()
    Dim d(3), e(2) As Integer
    Picture3.Cls
    i = 1: j = 1: m = 1: n = 1
    For i = 1 To 3
    For j = 1 To 2
    d(i) = d(i) + a(i, j)
    Next j
    Next i
    For n = 1 To 2
    For m = 1 To 2
    e(n) = e(n) + b(m, n)
    Next m
    m = 1
    Next n 矩阵乘法运算代码之二 ---- 计算阶段代码
    i = 1: n = 1
    For i = 1 To 3
    Picture3.Print
    For n = 1 To 2
    c(i, n) = d(i) * e(n)
    Picture3.Print c(i, n) & " ";
    Next n
    n = 1
    Next i
    End Sub