[已解决]如何将表中的条件公式转化为代码？

gwfzh

各位老师：表中第i列是按照公式=IF()求出的一列值。由于还有其它值需要代码求出，为方便，需要将此公式转变为代码，我自己试着写了一段代码，可输出的结果是错误的，如何写此公式的代码，请各位老师帮帮忙，在此先谢谢了！具体要求见附件。 HpQYpsEN.rar (14.64 KB, 下载次数: 12)

2009-12-22 10:36 上传

点击文件名下载附件
如何将表中的条件公式转化为代码？

最佳答案

月排行榜 / 总排行榜

amulee

2009-12-22 11:09

P列用不到？
Sub jodzxzhw1() '
    Dim ArrYS, lngRowN&, aa, ArrJG, i&, j%, strLing$, StrChuan$
    Application.ScreenUpdating = False
    aa = Timer
    lngRowN = Sheets("Sheet总表").Range("B65536").End(xlUp).Row
    ArrYS = Sheets("Sheet总表").Range("B3:H" & lngRowN)
    ReDim ArrJG(2 To UBound(ArrYS, 1), 1 To UBound(ArrYS, 2))
    For i = 2 To UBound(ArrYS, 1)
        '生成上一期传字符串
        StrChuan = Join(WorksheetFunction.Index(ArrYS, i - 1, 0))
        '生成上一期临字符串
        strLing = ""
        For j = 1 To UBound(ArrYS, 2)
            If ArrYS(i - 1, j) = 0 Then
                strLing = strLing & 1
            ElseIf ArrYS(i - 1, j) = 9 Then
                strLing = strLing & 8
            Else
                strLing = strLing & ArrYS(i - 1, j) - 1 & ArrYS(i - 1, j) + 1
            End If
            '顺便判断一下本期的传
            If InStr(1, StrChuan, ArrYS(i, j), vbTextCompare) > 0 Then ArrJG(i, j) = "传"
        Next j
        '判断本期
        For j = 1 To UBound(ArrYS, 2)
            If Len(ArrJG(i, j)) = 0 Then
                If InStr(1, strLing, ArrYS(i, j), vbTextCompare) > 0 Then
                    ArrJG(i, j) = "邻"
                Else
                    ArrJG(i, j) = "孤"
                End If
            End If
        Next j
    Next i
    Sheets("Sheet总表").Range("I4").Resize(UBound(ArrJG, 1) - 1, UBound(ArrJG, 2)) = ArrJG
    MsgBox "Done！共" & Format(Timer - aa, "0.0000") & "秒" '记录所用的时间
    Application.ScreenUpdating = True
End Sub

跳转到最佳答案楼层

amulee

P列用不到？
Sub jodzxzhw1() '
    Dim ArrYS, lngRowN&, aa, ArrJG, i&, j%, strLing$, StrChuan$
    Application.ScreenUpdating = False
    aa = Timer
    lngRowN = Sheets("Sheet总表").Range("B65536").End(xlUp).Row
    ArrYS = Sheets("Sheet总表").Range("B3:H" & lngRowN)
    ReDim ArrJG(2 To UBound(ArrYS, 1), 1 To UBound(ArrYS, 2))
    For i = 2 To UBound(ArrYS, 1)
        '生成上一期传字符串
        StrChuan = Join(WorksheetFunction.Index(ArrYS, i - 1, 0))
        '生成上一期临字符串
        strLing = ""
        For j = 1 To UBound(ArrYS, 2)
            If ArrYS(i - 1, j) = 0 Then
                strLing = strLing & 1
            ElseIf ArrYS(i - 1, j) = 9 Then
                strLing = strLing & 8
            Else
                strLing = strLing & ArrYS(i - 1, j) - 1 & ArrYS(i - 1, j) + 1
            End If
            '顺便判断一下本期的传
            If InStr(1, StrChuan, ArrYS(i, j), vbTextCompare) > 0 Then ArrJG(i, j) = "传"
        Next j
        '判断本期
        For j = 1 To UBound(ArrYS, 2)
            If Len(ArrJG(i, j)) = 0 Then
                If InStr(1, strLing, ArrYS(i, j), vbTextCompare) > 0 Then
                    ArrJG(i, j) = "邻"
                Else
                    ArrJG(i, j) = "孤"
                End If
            End If
        Next j
    Next i
    Sheets("Sheet总表").Range("I4").Resize(UBound(ArrJG, 1) - 1, UBound(ArrJG, 2)) = ArrJG
    MsgBox "Done！共" & Format(Timer - aa, "0.0000") & "秒" '记录所用的时间
    Application.ScreenUpdating = True
End Sub

gwfzh

谢谢amulee老师的帮助！

gwfzh

QUOTE:

以下是引用amulee在2009-12-22 11:09:00的发言：
P列用不到？
Sub jodzxzhw1() '
    Dim ArrYS, lngRowN&, aa, ArrJG, i&, j%, strLing$, StrChuan$
    Application.ScreenUpdating = False
    aa = Timer
    lngRowN = Sheets("Sheet总表").Range("B65536").End(xlUp).Row
    ArrYS = Sheets("Sheet总表").Range("B3:H" & lngRowN)
    ReDim ArrJG(2 To
  UBound(ArrYS, 1), 1 To
  UBound(ArrYS, 2))
    For i = 2 To
  UBound(ArrYS, 1)
        '生成上一期传字符串
        StrChuan = Join(WorksheetFunction.Index(ArrYS, i - 1, 0))
        '生成上一期临字符串
        strLing = ""
        For j = 1 To
  UBound(ArrYS, 2)
            If ArrYS(i - 1, j) = 0 Then
                strLing = strLing & 1
            ElseIf ArrYS(i - 1, j) = 9 Then
                strLing = strLing & 8
            Else
                strLing = strLing & ArrYS(i - 1, j) - 1 & ArrYS(i - 1, j) + 1
            End
  If
            '顺便判断一下本期的传
            If InStr(1, StrChuan, ArrYS(i, j), vbTextCompare) > 0 Then ArrJG(i, j) = "传"
        Next j
        '判断本期
        For j = 1 To
  UBound(ArrYS, 2)
            If Len(ArrJG(i, j)) = 0 Then
                If InStr(1, strLing, ArrYS(i, j), vbTextCompare) > 0 Then
                    ArrJG(i, j) = "邻"
                Else
                    ArrJG(i, j) = "孤"
                End
  If
            End
  If
        Next j
    Next i
    Sheets("Sheet总表").Range("I4").Resize(UBound(ArrJG, 1) - 1, UBound(ArrJG, 2)) = ArrJG
    MsgBox "Done！共" & Format(Timer - aa, "0.0000") & "秒" '记录所用的时间
    Application.ScreenUpdating = True
End
  Sub

amulee老师：能否将代码注释一下，有些地方不太明白，麻烦了！

amulee

加了点注释，看看可以不？

Sub jodzxzhw1() '
    Dim ArrYS, lngRowN&, aa, ArrJG, i&, j%, strLing$, StrChuan$
    Application.ScreenUpdating = False
    aa = Timer
    lngRowN = Sheets("Sheet总表").Range("B65536").End(xlUp).Row
    '原始数组
    ArrYS = Sheets("Sheet总表").Range("B3:H" & lngRowN)
    '结果数组
    ReDim ArrJG(2 To UBound(ArrYS, 1), 1 To UBound(ArrYS, 2))
    For i = 2 To UBound(ArrYS, 1)
        '生成上一期传字符串。取第i-1行的数组连接成字符串（文本）。
        StrChuan = Join(WorksheetFunction.Index(ArrYS, i - 1, 0))
        '生成上一期邻字符串，用来判断是否邻
        strLing = ""
        For j = 1 To UBound(ArrYS, 2)
            If ArrYS(i - 1, j) = 0 Then '若是0的话邻数只能是1
                strLing = strLing & 1
            ElseIf ArrYS(i - 1, j) = 9 Then '若是9的话邻数只能是8
                strLing = strLing & 8
            Else                        '其他情况邻数是该数加1或者减1
                strLing = strLing & ArrYS(i - 1, j) - 1 & ArrYS(i - 1, j) + 1
            End If
            '顺便判断一下本期的传。看当期的数字是否在上期的传字符串中。
            If InStr(1, StrChuan, ArrYS(i, j), vbTextCompare) > 0 Then ArrJG(i, j) = "传"
        Next j
        '判断本期
        For j = 1 To UBound(ArrYS, 2)
            If Len(ArrJG(i, j)) = 0 Then    '由于传已经判断完毕。剩下若是空的则未判断
                If InStr(1, strLing, ArrYS(i, j), vbTextCompare) > 0 Then   '看当期的数字是否在上期的邻字符串中
                    ArrJG(i, j) = "邻"
                Else            '在邻字符串的就是邻，否则就是孤
                    ArrJG(i, j) = "孤"
                End If
            End If
        Next j
    Next i
    '输出结果
    Sheets("Sheet总表").Range("I4").Resize(UBound(ArrJG, 1) - 1, UBound(ArrJG, 2)) = ArrJG
    MsgBox "Done！共" & Format(Timer - aa, "0.0000") & "秒" '记录所用的时间
    Application.ScreenUpdating = True
End Sub

zsd5237

学习[em02][em02]

xdwy81129

QUOTE:

以下是引用amulee在2009-12-22 14:24:00的发言：

加了点注释，看看可以不？

Sub jodzxzhw1() '
    Dim ArrYS, lngRowN&, aa, ArrJG, i&, j%, strLing$, StrChuan$
    Application.ScreenUpdating = False
    aa = Timer
    lngRowN = Sheets("Sheet总表").Range("B65536").End(xlUp).Row
    '原始数组
    ArrYS = Sheets("Sheet总表").Range("B3:H" & lngRowN)
    '结果数组
    ReDim ArrJG(2 To
  UBound(ArrYS, 1), 1 To
  UBound(ArrYS, 2))
    For i = 2 To
  UBound(ArrYS, 1)
        '生成上一期传字符串。取第i-1行的数组连接成字符串（文本）。
        StrChuan = Join(WorksheetFunction.Index(ArrYS, i - 1, 0))
        '生成上一期邻字符串，用来判断是否邻
        strLing = ""
        For j = 1 To
  UBound(ArrYS, 2)
            If ArrYS(i - 1, j) = 0 Then
  '若是0的话邻数只能是1
                strLing = strLing & 1
            ElseIf ArrYS(i - 1, j) = 9 Then
  '若是9的话邻数只能是8
                strLing = strLing & 8
            Else                        '其他情况邻数是该数加1或者减1
                strLing = strLing & ArrYS(i - 1, j) - 1 & ArrYS(i - 1, j) + 1
            End
  If
            '顺便判断一下本期的传。看当期的数字是否在上期的传字符串中。
            If InStr(1, StrChuan, ArrYS(i, j), vbTextCompare) > 0 Then ArrJG(i, j) = "传"
        Next j
        '判断本期
        For j = 1 To
  UBound(ArrYS, 2)
            If Len(ArrJG(i, j)) = 0 Then    '由于传已经判断完毕。剩下若是空的则未判断
                If InStr(1, strLing, ArrYS(i, j), vbTextCompare) > 0 Then   '看当期的数字是否在上期的邻字符串中
                    ArrJG(i, j) = "邻"
                Else            '在邻字符串的就是邻，否则就是孤
                    ArrJG(i, j) = "孤"
                End
  If
            End
  If
        Next j
    Next i
    '输出结果
    Sheets("Sheet总表").Range("I4").Resize(UBound(ArrJG, 1) - 1, UBound(ArrJG, 2)) = ArrJG
    MsgBox "Done！共" & Format(Timer - aa, "0.0000") & "秒" '记录所用的时间
    Application.ScreenUpdating = True
End
  Sub

很好，学习，可惜一些没有标明

[此贴子已经被作者于2009-12-23 7:38:06编辑过]