Question

我一直在研究这段代码。正如你在代码行“With ws（2）”之后看到的那样，有一个if条件。现在，我有多个创建多个这样的If条件，例如0.6,0.7,0.8等（并且每个这样的条件应该使用不同的数据表）{我发布了 excel文件链接表格以便你可以得到一个想法}我可以使用函数或任何不需要我为每个新条件一次又一次地编写此代码的方法吗？

https://docs.google.com/file/d/0B1DVNSutDHR0QWd2UUJsVDZ1Tm8/edit

Private Sub CommandButton1_Click()

Dim x(1 To 9000) As Double, y(1 To 9000) As Double, x1 As Double, y1 As Double, x2 As Double, y2 As Double, I1(1 To 9000) As Double, I2(1 To 9000) As Double, R1(1 To 9000) As Double, R2(1 To 9000) As Double, a As Double, b As Double, c As Double, d As Double, Result(1 To 9000) As Double

Dim i As Integer, j As Integer, k As Integer, p As Integer, q As Integer, r As Integer, s As Integer, t As Integer
Dim ws As Sheets
Set ws = ActiveWorkbook.Sheets(Array("Sheet1", "PLP-1", "PLP-2"))

For t = 0 To 120 Step 20

For k = 1 To 9000

With ws(1)
  I1(k) = .Cells(k + 2, 13).Value
  I2(k) = .Cells(k + 2, 14).Value
End With

With ws(2)

Select Case .Cells(6 + t, 1).Value

Case 0.5:
r = 0
s = 0

Case 0.6:
r = 20
s = 1

Case 0.7:
r = 40
s = 2

Case 0.8:
r = 60
s = 2

Case 0.9:
r = 80
s = 3

Case 1:
r = 100
s = 4

Case 1.1:
r = 120
s = 5

End Select

For i = 7 To 22

 If (.Cells(i + r, 1).Value <= I1(k)) And (I1(k) <= .Cells(i + r + 1, 1).Value) And Not (IsEmpty(I1(k))) Then
  p = i + r
 x(k) = I1(k)
 x1 = .Cells(i + r, 1).Value
 x2 = .Cells(i + r + 1, 1).Value

 End If
 Next i

For j = 2 To 8

If (.Cells(6 + r, j).Value <= I2(k)) And (I2(k) <= .Cells(6 + r, j + 1).Value) And Not (IsEmpty(I2(k))) Then
 q = j + r
 y(k) = I2(k)
 y1 = .Cells(6 + r, j).Value
 y2 = .Cells(6 + r, j + 1).Value

End If
Next j

 If p <> 0 And q <> 0 Then

 a = .Cells(p, q).Value
 b = .Cells(p, q + 1).Value
 c = .Cells(p + 1, q).Value
 d = .Cells(p + 1, q + 1).Value

End If


    If I1(k) = Empty Then

    R1(k) = 0

    Else
    R1(k) = (((y2 - y(k)) / (y2 - y1)) * a) + (((y(k) - y1) / (y2 - y1)) * b)

    End If


    If I2(k) = Empty Then

    R2(k) = 0

    Else

    R2(k) = (((y2 - y(k)) / (y2 - y1)) * c) + (((y(k) - y1) / (y2 - y1)) * d)

    End If


Result(k) = (((x2 - x(k)) / (x2 - x1)) * R1(k)) + (((x(k) - x1) / (x2 - x1)) * R2(k))

End With

With ws(1)

.Cells(k + 2, 15 + s).Value = Result(k)

End With

Next k
Next t


End Sub

Answer 1

尝试使用Select Case语句，如下所示：

Dim iStart As Long, iEnd As long, jStart As Long, jEnd As Long
'...
With ws(2)
    Select Case .Cells(6, 1).Value
        Case 0.5:
            iStart = 7: iEnd = 22
            jStart = 2: jEnd = 7
        Case 0.6:
            'Same as above but substitute new values for iStart etc.
    End Select

    For i = iStart To iEnd
        'DO STUFF WITH i
    Next i

    For j = jStart To jEnd
        'DO STUFF WITH j
    Next j
End With

编辑：已更新，以反映评论中澄清的需求

可以找到Select Case更深入的解释和使用指南here

Answer 2

关于循环，如果我理解你的代码，你需要遍历每个“表”，但你的I和J指的是绝对地址。你想要的是让I和J相对于所需的桌子。

我只使用了2到7的值，但是如果表的大小不同，你当然可以用代码来确定;或者甚至将它们读入变量数组并在数组上进行测试（通常会更快）。

如下所示（伪代码）

Option Explicit
'N is the Value that defines the proper table
Function DoYourThingOnProperRange(N As Double)
Dim C As Range
Dim I As Long, J As Long

With Sheet1.Columns(1)
    Set C = .Find(what:=N, after:=Sheet1.Cells(Rows.Count, "A"), LookIn:=xlValues, _
        lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlNext)
    If Not C Is Nothing Then
        Set C = C.CurrentRegion 'C is now set to the proper table

        'DoYourThing
        'Here's just a dummy routine
        For I = 2 To 7
            For J = 2 To 7
                Debug.Print C(I, J).Address
            Next J
        Next I

    Else
        'some kind or error routine for non-existent table
    End If
End With

End Function

在VBA中使用功能excel

2 个答案: