从单元格A1复制矩阵

时间:2016-11-29 10:04:07

标签: excel vba excel-vba

我对VBA编程很新,一般在Excel宏中。 这是我到目前为止编写的代码:

Private Sub GeneraTabella_Click()
Dim initialDate As Date
initialDate = Worksheets("Sheet1").Range("G1")

Dim MyArray() As Variant, NewMatrix(78, 4) As Integer
MyArray = Worksheets("Sheet1").Range("K1:N78").Value

Dim k, offset1, offset2 As Integer

Dim uguale As Boolean

For i = 1 To 10 Step 1
    uguale = False
    For j = 4 To 1 Step -1
        k = 1

        If uguale = True Then
            'k = k + 1
            j = j - k
            uguale = False
        End If

        If j = 4 Then
            offset1 = Abs(dateDiff("d", MyArray(i, j), initialDate))
            NewMatrix(offset1, j) = NewMatrix(offset1, j) + 1
        End If

        If (j - k) <= 0 Then
            GoTo continue
        End If

        offset1 = Abs(dateDiff("d", MyArray(i, j), initialDate))
        offset2 = Abs(dateDiff("d", MyArray(i, j - k), initialDate))

        'NewMatrix(offset1, j) = NewMatrix(offset1, j) + "+"
        Do While offset1 = offset2
            k = k + 1
            uguale = True
            If (j - k) <= 0 Then
                uguale = False
                GoTo continue
            End If
            'offset1 = Abs(dateDiff("d", MyArray(i, j), initialDate))
            offset2 = Abs(dateDiff("d", MyArray(i, j - k), initialDate))
        Loop

        If offset1 <> offset2 Then
            NewMatrix(offset1, j - k) = NewMatrix(offset1, j - k) - 1
            NewMatrix(offset2, j - k) = NewMatrix(offset2, j - k) + 1
        End If

        If (j - k) = 1 Then
            GoTo break
        End If

continue:
        Next j
break:
    Next i
    Worksheets("Sheet2").Range("A1:E78") = NewMatrix
End Sub

为什么Worksheets("Sheet2").Range("A1:E78") = NewMatrix不会从Panel A1中复制Sheet2?它从单元格B2开始。 如果您有一些提示来改进我的vba样式代码,请告诉我。 提前谢谢。

0 个答案:

没有答案