楼主
biaotiger1 |
Q：如何用VBA获取100以内满足条件的不重复的三个数并写入单元格？
A：ALT+F11→“插入”→“模块”，在该模块的代码窗口中输入代码如下- Sub 获取不重复的三条边组成三角形的面积与周长比为整数1()
- Dim a, b, c, d, r
- Dim aa()
- Application.ScreenUpdating = False
- r = 1
- Range("a" & r & ":e" & r) = Array("边长1", "边长2", "边长3", "面积", "周长")
- For a = 2 To 98
- For b = a + 1 To 99
- For c = b + 1 To 100
- If a + b > c And a + c > b And b + c > a Then
- d = Sqr((a + b + c) * (a + b - c) * (a + c - b) * (b + c - a)) / 4
- If d / (a + b + c) = d \ (a + b + c) Then
- r = r + 1
- ReDim Preserve aa(1 To r)
- aa(r) = a + b + c
- Range("a" & r & ":e" & r) = Array(a, b, c, d, aa(r))
- End If
- End If
- Next
- Next
- Next
- Application.ScreenUpdating = True
- End Sub
- Sub 获取不重复的三条边组成三角形的面积与周长比为整数2()
- Dim a, b, c, d, r
- Dim aa()
- Application.ScreenUpdating = False
- r = 1
- Range("a" & r & ":e" & r) = Array("边长1", "边长2", "边长3", "面积", "周长")
- For a = 2 To 98
- For b = a + 1 To 99
- For c = b + 1 To 100
- If a + b > c And a + c > b And b + c > a Then
- d = Sqr((a + b + c) * (a + b - c) * (a + c - b) * (b + c - a)) / 4
- If d / (a + b + c) = d \ (a + b + c) Then
- r = r + 1
- ReDim Preserve aa(1 To 5, 2 To r)
- aa(1, r) = a: aa(2, r) = b: aa(3, r) = c: aa(4, r) = d: aa(5, r) = a + b + c
- End If
- End If
- Next
- Next
- Next
- [A2].Resize(UBound(aa, 2) - 1, 5) = WorksheetFunction.Transpose(aa)
- Application.ScreenUpdating = True
- End Sub
|