了解范围和数组

第一节第一节第一节第一节第一次

• 很多内容都已更改，因此您的一些评论可能不再适用。

Option Explicit

Sub TamsayiliRasgeleMatris()
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' Improve!
    
    'Kullanicidan girdiler alma
    Dim rCount As Long: rCount = ws.Range("A2").Value
    Dim cCount As Long: cCount = ws.Range("B2").Value
    Dim MinInteger As Long: MinInteger = ws.Range("C2").Value
    Dim MaxInteger As Long: MaxInteger = ws.Range("D2").Value
    
    'Boş bir matris oluşturma
    Dim Matrix() As Variant: ReDim Matrix(1 To rCount, 1 To cCount)
    
    Dim r As Long, c As Long, Total As Long
    
    'Matrisi rastgele sayilarla doldurma
    For r = 1 To rCount
        For c = 1 To cCount
            Matrix(r, c) = Int((MaxInteger - MinInteger + 1) * Rnd + MinInteger)
            Total = Total + Matrix(r, c)
        Next c
    Next r
    ws.Range("E2").Value = Total
    
    Dim rg As Range, fCell As Range
    
    'Matrisi çalişma sayfasina yazma
    Set fCell = ws.Range("B5")
    
    With fCell
        .Resize(ws.Rows.Count - .Row + 1, ws.Columns.Count - .Column + 1).Clear
    End With
    
    Set rg = fCell.Resize(rCount, cCount)
    
    rg.Value = Matrix
    
    'Ortalama degerini hesaplayin ve F2 hücresine yazma
    Dim Avg As Double: Avg = Total / (rCount * cCount)
    ws.Range("F2").Value = Avg
    
    'Degerleri ortalama degerine göre renklendirin
    For r = 1 To rCount
        For c = 1 To cCount
            Select Case Matrix(r, c)
                Case Is < Avg: rg.Cells(r, c).Interior.Color = vbCyan
                Case Is > Avg: rg.Cells(r, c).Interior.Color = vbMagenta
                Case Else ' !?
            End Select
        Next c
    Next r
    
    'Matris transpozunu oluşturun ve altina yapiştirin
    Dim tMatrix() As Long: ReDim tMatrix(1 To cCount, 1 To rCount)
    For r = 1 To rCount
        For c = 1 To cCount
            tMatrix(c, r) = Matrix(r, c)
        Next c
    Next r
    
    Set fCell = fCell.Offset(rCount + 1)
    Set rg = fCell.Resize(cCount, rCount)
    
    rg.Value = tMatrix
    
    'Degerleri ortalama degerine göre renklendirin
    For c = 1 To cCount
        For r = 1 To rCount
            Select Case tMatrix(c, r)
                Case Is < Avg: rg.Cells(c, r).Interior.Color = vbCyan
                Case Is > Avg: rg.Cells(c, r).Interior.Color = vbMagenta
                Case Else ' !?
            End Select
        Next r
    Next c
    
End Sub

以下是一些建议，可能会使您的代码运行
考虑以下代码片段：

Dim matrix As Variant
matrix = Range("B5").Resize(rows, cols)

因为：

• matrix被声明为Variant类型
• Value是任何Range对象的默认属性

那么matrix最终会得到一个Variant数组，就像你编写了：

matrix = Range("B5").Resize(rows, cols).Value

接下来您将编写：

matrix.Copy Destination:=Range("B5")

这将导致错误，因为数组没有任何Copy方法，而后者可用于许多对象，其中包括Range对象
因此，您应该"反转"基准表分配代码行，如下所示：

'Matrisi çalisma sayfasina yazma
Range("B5").Resize(rows, cols).Value = matrix

稍微复杂一点的是修复另一个错误的Copy语句

Dim transposed As Variant
transposed = Application.Transpose(matrix)
transposed.Copy Destination:=Range("B5").Offset(rows + 1, 0)

其沿着先前定位的路线将被编码如下：

Dim transposed As Variant
    transposed = Application.Transpose(matrix)
    Range("B5").Offset(rows + 1, 0).Resize(cols, rows).Value = transposed

您会注意到，我在Resize()属性中交换了cols和rows，以考虑换位
最后是以下片段：

'Değerleri ortalama değerine göre renklendirin
For i = 1 To rows
For j = 1 To cols
If matrix(i, j) < average Then
matrix(i, j).Interior.Color = vbCyan
ElseIf matrix(i, j) > average Then
matrix(i, j).Interior.Color = vbMagenta
End If
Next j
Next i

将按如下方式勾选：

With Range("B5") 'reference the target range upper-left cell
    For i = 1 To rows
        For j = 1 To cols
            If matrix(i, j) < average Then
                .Offset(i - 1, j - 1).Interior.Color = vbCyan 'write in the cell corresponding to the ith row and jth column of matrix
            ElseIf matrix(i, j) > average Then
                .Offset(i - 1, j - 1).Interior.Color = vbMagenta
            End If
        Next
    Next
End With