|
|
由于“线路”数字中有文本，使用导入数据会把文本当作空白，使用vba吧：
Sub Macro1() '每个表“线路”的第一个单元格加上一个撇号“'”，否则会把“19红”、“19兰”当作空白
'引用Microsoft ActiveX Data Objects 2.x Library
Dim cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim SQL$, s, arr(1 To 6), i&, j&, d As Object, t
Set d = CreateObject("scripting.dictionary")
For i = 1 To 6
With Sheets(i)
d(.Name) = .[c2].Value
If i = 1 Then
s = .[a2] & "," & .[b2] & ",sum(" & .[c2] & ") as " & .[c2]
Else
s = s & ",sum(" & .[c2] & ") as " & .[c2]
End If
End With
Next
t = d.items
For i = 1 To 6
With Sheets(i)
For j = 0 To d.Count - 1
If d(.Name) = t(j) Then '该工作表存在该字段
arr(i) = arr(i) & "," & t(j)
Else
arr(i) = arr(i) & "," & "0 as " & t(j) '该工作表不存在该字段要添加 0 as 字段
End If
Next
arr(i) = "select 线路,车号," & Mid(arr(i), 2) & " from [" & .Name & "$a2:c65536] where 车号<>'合计' and 车号 is not null "
End With
Next
SQL = Join(arr, " UNION ALL ")
SQL = "select " & s & " from (" & SQL & ") group by 线路,车号"
cnn.Open "Provider=Microsoft.Jet.OleDb.4.0;Extended Properties='Excel 8.0;imex=1';Data Source=" & ThisWorkbook.FullName
rs.Open SQL, cnn, 1, 3
ActiveSheet.UsedRange.ClearContents
For i = 1 To rs.Fields.Count
Cells(1, i) = rs.Fields(i - 1).Name
Next
Cells(1, i) = "合计"
[a2].CopyFromRecordset rs
Cells(2, i).Resize(rs.RecordCount) = "=SUM(RC[-6]:RC[-1])"
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
End Sub |
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2011-2-5 08:39
楼主