Question

我需要设置一个2D数组并随机用颜色填充其中的一定数量的单元格，就好像数组是一个容器而细胞是分子。之后我需要对它们执行操作。我试过的代码是：

; Directory in which the loadable extensions (modules) reside.
; http://php.net/extension-dir
; extension_dir = "./"
; On windows:
extension_dir = "C:\Program Files (x86)\PHP\ext"

但我想到的是，在这种情况下，即使我没有设置阵列，它也会用颜色填充整个范围。但是我需要在数组中随机填充 - 我尝试了 Rnd 功能，但我并不是真的知道如何正确使用它并且它没有＆＃39;工作。

我试过的是

; Directory in which the loadable extensions (modules) reside. ; http://php.net/extension-dir ; extension_dir = "./" ; On windows: extension_dir = "Y:\Program Files (x86)\PHP\ext"

我只是觉得我离开了这里并且我一无所知。我很感激你的帮助。

Answer 1

这将随机填充您正在使用的工作簿中活动工作表的前10行和10列中的1到100个单元格。

Sub Insert_Molecules()

Dim Molecules() As Integer

Dim m As Integer, n As Integer
Dim i As Integer, j As Integer
Dim NumOfTimes as Integer

Randomize
NumOfTimes  = Int ((100 - 1 + 1) * Rnd + 1)

For i = 1 to NumOfTimes
    Randomize
    Cells(Int ((10 - 1 + 1) * Rnd + 1),Int ((10 - 1 + 1) * Rnd + 1)).Interior.Color = RGB(255,0,0)
Next i   

End Sub

Answer 2

Sub tgr()

    Dim lWidth As Long
    Dim lHeight As Long
    Dim lMolecules As Long
    Dim lArea As Long
    Dim lRandom As Long
    Dim i As Long, j As Long
    Dim sCells As String
    Dim sRandom As String
    Dim rMolecules As Range

    'Get width of container
    lWidth = Int(Application.InputBox("Provide width of container (must be a positive integer)", "Width", 10, Type:=1))
    If lWidth < 1 Then
        MsgBox "Invalid with [" & lWidth & "] provided.  Width must be a positive integer.  Exiting."
        Exit Sub
    End If

    'Get height of container
    lHeight = Int(Application.InputBox("Provide Height of container (must be a positive integer)", "Height", 10, Type:=1))
    If lHeight < 1 Then
        MsgBox "Invalid with [" & lHeight & "] provided.  Height must be a positive integer.  Exiting."
        Exit Sub
    End If

    'Get number of molecules to randomly fill within container
    lMolecules = Int(Application.InputBox("Provide Molecules of container (must be a positive integer)", "Molecules", 10, Type:=1))
    If lMolecules < 1 Then
        MsgBox "Invalid with [" & lMolecules & "] provided.  Molecules must be a positive integer.  Exiting."
        Exit Sub
    End If

    lArea = lWidth * lHeight

    'Populate string of cells that make up the container so they can be chosen at random
    For i = 1 To lHeight
        For j = 1 To lWidth
            sCells = sCells & "|" & Cells(i, j).Address
        Next j
    Next i
    sCells = sCells & "|"

    'Color the molecules at random
    For i = 1 To WorksheetFunction.Min(lMolecules, lArea)
        Randomize
        lRandom = Int(Rnd() * lArea) + 1
        sRandom = Split(sCells, "|")(lRandom)
        Select Case (i = 1)
            Case True:  Set rMolecules = Range(sRandom)
            Case Else:  Set rMolecules = Union(rMolecules, Range(sRandom))
        End Select
        sCells = Replace(sCells, "|" & sRandom & "|", "|")
        lArea = lArea - 1
    Next i

    rMolecules.Interior.ColorIndex = 3

End Sub

VBA - 在VBA中设置一个2D数组，其中随机单元格填充颜色

2 个答案: