在VBA中使用函数excel
我一直在研究这个代码。 正如您在代码行“With ws（2）”后可以看到的那样存在if条件。 现在，我有多个创build多个这样的条件，如为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 关于你的循环，如果我理解你的代码，你需要遍历每个“表”，但是你的I和J指的是绝对地址。 你想要的是让我和J相对于所需的表格。
我只是使用2到7的值，但是如果这些表是不同的大小，你当然可以用代码来确定; 或者甚至将它们读入一个变体数组中，并对数组进行testing（通常会更快）。
所以像下面的东西（伪代码）
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
尝试使用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的更深入的解释和使用指南可以在这里find