|
用SQL好象无法做。下面是用数组的做法,请查看。
Sub 清除()
Range("d6:k17").ClearContents
Range("l7:q17").ClearContents
MsgBox "数据已清除!"
End Sub
Sub 保存()
Dim Rdate, arr(), i%, j%, brr
With Sheet1
arr = .Range("a3").CurrentRegion
End With
If Len(arr(2, 6)) > 0 And Len(arr(3, 6)) > 0 Then
With Sheet2
j = .Range("A65536").End(xlUp).Row + 1
.Cells(j, 1) = arr(1, 16) '日期
.Cells(j, 2) = arr(2, 6) 's
.Cells(j, 3) = arr(3, 6) 'p_n
.Cells(j, 4) = arr(5, 4) '1#总数
.Cells(j, 5) = arr(5, 8) '2#总数
For i = 6 To UBound(arr)
.Cells(j, 6 + k) = arr(i, 4) '1# 列表数
k = k + 1
Next
For i = 6 To UBound(arr)
.Cells(j, 6 + k) = arr(i, 8) '2# 列表数
k = k + 1
Next
For i = 6 To UBound(arr)
.Cells(j, 6 + k) = arr(i, 12) '其它1# 列表数
k = k + 1
Next
For i = 6 To UBound(arr)
.Cells(j, 6 + k) = arr(i, 13) '其它2# 列表数
k = k + 1
Next
For i = 6 To UBound(arr)
.Cells(j, 6 + k) = arr(i, 14) '其它3# 列表数
k = k + 1
Next
For i = 6 To UBound(arr)
.Cells(j, 6 + k) = arr(i, 15) '其它4# 列表数
k = k + 1
Next
For i = 6 To UBound(arr)
.Cells(j, 6 + k) = arr(i, 16) '其它5# 列表数
k = k + 1
Next
For i = 6 To UBound(arr)
.Cells(j, 6 + k) = arr(i, 17) '其它6# 列表数
k = k + 1
Next
End With
Else
If Len(arr(2, 6)) = 0 Then MsgBox "" & arr(2, 4) & " 数据不全"
If Len(arr(3, 6)) = 0 Then MsgBox "" & arr(3, 4) & " 数据不全"
End If
End Sub
|
|