Home > database >  How can i solve this excel macro bug
How can i solve this excel macro bug

Time:12-29

i can't find where i am doing wrong my code is not working so. I'm a bit of a novice at this, I don't quite understand what the problem is

it gives me warning on this line matrix = Range("B5").Resize(rows, cols)

Sub TamsayiliRasgeleMatris()

'Deklarasyonlar
Dim rows As Integer, cols As Integer
Dim lowerBound As Integer, upperBound As Integer
Dim sum As Double, average As Double

'Kullanıcıdan girdiler alma
rows = Range("A2").Value
cols = Range("B2").Value
lowerBound = Range("C2").Value
upperBound = Range("D2").Value

'Boş bir matris oluşturma
Dim matrix As Variant
matrix = Range("B5").Resize(rows, cols)

'Matrisi rastgele sayılarla doldurma
For i = 1 To rows
For j = 1 To cols
matrix(i, j) = Int((upperBound - lowerBound   1) * Rnd   lowerBound)
sum = sum   matrix(i, j)
Next j
Next i

'Matrisi çalışma sayfasına yazma
matrix.Copy Destination:=Range("B5")

'Ortalama değerini hesaplayın ve E2 hücresine yazma
average = sum / (rows * cols)
Range("E2").Value = average

'Matris transpozunu oluşturun ve altına yapıştırın
Dim transposed As Variant
transposed = Application.Transpose(matrix)
transposed.Copy Destination:=Range("B5").Offset(rows   1, 0)

'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

End Sub

CodePudding user response:

Here follow some suggestion to possibly make your code run

taking in consideration the following code snippet:

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

since:

  • matrix is declared as of Variant type
  • Value is the default property for any Range object

then matrix is finally resulting in a Variant array, as if you had coded:

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

further on you are coding:

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

which would result in an error since an array doesn't have any Copy method, while this latter is available for many objects, among which the Range object

hence you should sort of "reverse" the matrix assignation code line as follows:

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

just a little more complicated is the fix of the other wrong Copy statement

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

which, along the lines of the preceeding fix, is to be coded as follows:

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

and where you'll notice I swapped cols and rows in the Resize() property to account for transposition

finally the following snippet:

'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

is to be twicked as follows:

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

CodePudding user response:

enter image description here

  • A lot was changed so some of your comments may not apply anymore.
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, cell As Range
    
    'Matrisi çalişma sayfasina yazma
    Set fCell = ws.Range("B5")
    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 Each cell In rg.Cells
        Select Case cell.Value
            Case Is < Avg: cell.Interior.Color = vbCyan
            Case Is > Avg: cell.Interior.Color = vbMagenta
            Case Else ' !?
        End Select
    Next cell
    
    '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
    
    Dim trg As Range, tfCell As Range
    
    Set fCell = fCell.Offset(rCount   1)
    Set rg = fCell.Resize(cCount, rCount)
    
    rg.Value = tMatrix
    
    'Degerleri ortalama degerine göre renklendirin
    For Each cell In rg.Cells
        Select Case cell.Value
            Case Is < Avg: cell.Interior.Color = vbCyan
            Case Is > Avg: cell.Interior.Color = vbMagenta
            Case Else ' !?
        End Select
    Next cell
    
End Sub
  • Related