我对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样式代码,请告诉我。
提前谢谢。