如何在VBA中为不同范围的单元格指定值

时间:2017-02-17 18:35:50

标签: excel vba excel-vba random vlookup

我正在尝试随机生成1到100之间的整数,无论​​是在单元格中还是在vba代码中。然后我想使用该值作为VLookup的查找值,该值将从另一个工作表中提取1到10之间的另一个随机生成的整数。然后我想使用1到10之间的第二个数字作为指标来填充列中的许多单元格,其中第一个数字介于1和100之间。

因此,例如,如果我手动执行:我将在Sheet1 =MROUND(RANDBETWEEN(1,100),1)上的单元格“C27”中。假设它返回40.然后我会在Sheet2上查看A列中的数字40,查看D列,其中有另一个=MROUND(RANDBETWEEN(1,10),1)。假设一个返回5(所以我需要填写一列的5个单元格)。然后我会回到Sheet1并在单元格K31到K35(原始随机整数)中输入40。

我知道RANDRANDBETWEEN会在工作表重新计算时随时更新。我使用触发的IF语句来防止它们更新,除非我更改触发器单元格中的值。如果使用VBA生成随机数使得更容易,我就是全部。

我不认为发布我尝试过的多次迭代会对我有所帮助,因为我试图将解决方案应用于此宏的每个单独任务。他们似乎都没有让我接近。但这就是我现在正在使用的东西,它甚至还没有接近。这段代码让我试着把它带到工作期间。所以数字是静态的而不是随机的。但我需要它们随机。是的,这对我来说是为我的D& D游戏掌握产生随机怪物:)

感谢任何能够让我走上正轨的人!

Sub MonsterRoll()
'
' MonsterRoll

Dim ws As Worksheet
Dim roll As Integer
Dim No1 As Integer
Dim No2 As Integer

Set ws = Sheets("Combat Helper")
roll = 5
No1 = 31
No2 = 31 + 5

On Error Resume Next
For i = No1 To No2
    area.Cells(i, 11).Value = 5
Next

End Sub

This table houses the vlookups into sheet "Encounters"

This table contains the source data, with column D being a RANDBETWEEN

1 个答案:

答案 0 :(得分:1)

我仍然不确定一些细胞参考,但我想我有一个大概的想法。下面的代码可以作为你想要的大部分内容的起点 - 只需几个警告......

由于您正在监视Sheet1单元格K31:K50中的更改,然后对同一范围进行更改,这将再次触发更改事件。因此,为了避免疯狂的结果,我添加了一个标志,以便它会忽略更改,直到你告诉它停止忽略。这将是您完成原始更改的所有处理。

就个人而言,我更愿意通过代码生成我自己的随机数,原因很简单,任何更改任何单元格都会触发所有随机数字。要重新生成的数字。

转到功能' Set_All_Cell_Values'并添加填写其他单元格所需的任何代码。

Option Explicit

Dim blnIgnoreChanges    As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws1     As Worksheet
Dim ws2     As Worksheet
Dim i       As Integer
Dim iYourNbr    As Integer
Dim iMyNbr  As Integer
Dim iRow    As Integer
Dim iHowMany    As Integer
Dim Why     As String

    ' The following code can be dangerous if your code is not working properly!!!!
    ' Since you want to 'monitor' changes to K31:K50, and then change those same cells via code,
    ' which will in turn trigger this 'Worksheet_Change' subroutine to fire again,
    ' you need to be able to ignore changes on demand.
    ' If this flag gets set and your code didn't complete (AND turn the flag off), then
    ' any monitoring of future changes will be ignored!!
    ' If the flag fails to get reset, then just execute the following code in the immediate window:
    '  blnIgnoreChanges =  false

    If blnIgnoreChanges = True Then
        Exit Sub
    End If

    Set ws1 = ThisWorkbook.Worksheets("Combat Helper")
    Set ws2 = ThisWorkbook.Worksheets("Encounters")

' Sample data in Sheet2
' A       B          C   D   E    F  G   H    I   J
'40  Bird, Falcon    1   1   1   -10 5   2   1d4  t
'41  Men: Wild Man   2   3   2   -9  2   3   1d5  u
'42  Beast           3   5   3   -8  3   4   1d6  v
'43  Elephant        4   7   4   -7  4   5   1d7  w

    ' Monitor only cells K31:K50
    If Target.Row >= 31 And Target.Row <= 50 And Target.Column = 11 Then
        ' Value must be between 1 and 100
        If Target.Value < 1 Or Target.Value > 100 Then
            MsgBox "Must enter between 1 and 100"
            Exit Sub
        Else
            ' If you want to Lookup match in Col A of Sheet2, and then get value from col D.
            iYourNbr = Application.VLookup(Target.Value, ws2.Range("A3:N102"), 4, False)
            ' I prefer to Generate my own random number between 1 and 10
            iMyNbr = Int((10 - 1 + 1) * Rnd + 1)
            iRow = Find_Matching_Value(Target.Value)
            Debug.Print "Matching Row in Sheet2 is: " & iRow

            ' DANGER!! If you execute the following line of code, then you MUST set to FALSE
            ' when you have finished one change!!!
            blnIgnoreChanges = True

            iHowMany = Sheet2.Cells(iRow, 4).Value
            Sheet1.Cells(Target.Row, 13) = iHowMany
            Set_All_Cell_Values Target.Row, iRow, iHowMany


        End If
    ' We can ignore all other cell changes
    Else
        'Debug.Print "Change made to: " & "R" & Target.Row & ":C" & Target.Column & " but not my row or column!   Value is:" & Target.Value
    End If

End Sub

Function Set_All_Cell_Values(iS1Row As Integer, iS2Row As Integer, iHowMany As Integer)
Dim i       As Integer

    Debug.Print "Add code to set cells for Sheet1 R:" & iS1Row & " Sheet2 R:" & iS2Row

    For i = iS1Row + 1 To iS1Row + iHowMany - 1
        Sheet1.Cells(i, 11) = Sheet1.Cells(iS1Row, 11)

        '#################################################
        ' ADD CODE TO FILL OTHER CELLS as needed!!!
        '#################################################
    Next i

    blnIgnoreChanges = False
End Function

Function Find_Matching_Value(iFind As Integer) As Integer
Dim Rng     As Range
    If Trim(iFind) <> "" Then
        With Sheets("Encounters").Range("A:A")
            Set Rng = .Find(What:=iFind, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                Find_Matching_Value = Rng.Row
            Else
                MsgBox "Did not find match for value: " & iFind
            End If
        End With
    Else
        MsgBox "You passed an empty value to 'Find_Matching_Value'"
    End If
End Function
相关问题