|
今天来看看梁总出的练习题哈
转换成下面的二维表效果图（要求：必须要跟效果表一致）
==我是分隔线，www.vbafans.com==
方法1：
小子大神Python：
import xlrd
import xlwt
s = set()
d = {}
a = 0
rs = 0
cs =0
f = xlwt.Workbook()
st = f.add_sheet(r'newcity',cell_overwrite_ok=True)
wb = xlrd.open_workbook(r'E:\excel\city.xlsm')
sh = wb.sheets()[0]
for i in range(1,sh.nrows):
d[sh.cell_value(i,1) sh.cell_value(i,0)]=sh.cell_value(i,2)
d[sh.cell_value(i,0) sh.cell_value(i,1)]=sh.cell_value(i,2)
s.add(sh.cell_value(i,1))
s.add(sh.cell_value(i,0))
for r in s:
rs = 1
cs =0
for c in s:
cs =1
if r c in d:
st.write(cs,rs,d[r c])
else:
st.write(cs,rs,0)
st.write(rs,0,r)
st.write(0,rs,r)
print(d)
print(s)
f.save(r'E:\\excel\\citys.xls')
==我是分隔线，www.vbafans.com==
方法2：
诗人：
Sub cdsr()
Dim arr, brr(), d As Object, d1 As Object, i&, s, j&
arr = Sheet6.[a1].CurrentRegion
Set d = CreateObject('scripting.dictionary')
Set d1 = CreateObject('scripting.dictionary')
For i = 2 To UBound(arr)
d(arr(i, 1)) = ''
d(arr(i, 2)) = ''
d1(arr(i, 1) & arr(i, 2)) = arr(i, 3)
Next
s = d.keys
ReDim brr(1 To d.Count 1, 1 To d.Count 1)
For i = 2 To UBound(brr)
brr(i, 1) = s(i - 2)
brr(1, i) = s(i - 2)
Next
For i = 2 To UBound(brr)
For j = 2 To UBound(brr, 2)
brr(i, j) = d1(brr(i, 1) & brr(1, j))
If brr(i, j) = '' Then
brr(i, j) = d1(brr(1, j) & brr(i, 1))
End If
Next
Next
Sheet7.Cells.ClearContents
Sheet7.[a1].Resize(UBound(brr), UBound(brr, 2)) = brr
End Sub |
==我是分隔线，www.vbafans.com==
方法3：
李长老：
Sub lzl()
Dim d, d1, arr, i, a, n%
Set d = CreateObject('scripting.dictionary')
Set d1 = CreateObject('scripting.dictionary')
arr = Range('a2:c' & Cells(Rows.Count, 1).End(3).Row)
For i = 1 To UBound(arr)
d(arr(i, 1)) = ''
d1(arr(i, 1) & '-' & arr(i, 2)) = arr(i, 3)
d1(arr(i, 2) & '-' & arr(i, 1)) = arr(i, 3)
Next
For i = 1 To UBound(arr)
d(arr(i, 2)) = ''
Next
Dim brr(1 To 100, 1 To 100)
n = 1
For Each a In d.keys
n = n 1
brr(n, 1) = a
brr(1, n) = a
Next
For i = 2 To d.Count 1
For n = 2 To d.Count 1
If i = n Then
brr(i, n) = 0
ElseIf d1.Exists(brr(i, 1) & '-' & brr(1, n)) Then
brr(i, n) = d1(brr(i, 1) & '-' & brr(1, n))
ElseIf d1.Exists(brr(1, n) & '-' & brr(i, 1)) Then
brr(i, n) = d1(brr(1, n) & '-' & brr(i, 1))
Else
brr(i, n) = ''
End If
Next
Next
Sheets('Matrix').Range('a1').Resize(d.Count 1, d.Count 1) = brr
End Sub
==我是分隔线，www.vbafans.com==
方法4：
bajifeng:
Sub b() 'bajifeng
Set d = CreateObject('Scripting.Dictionary')
ar = [a2].Resize([a65536].End(3).Row - 1, 3)
For i = 1 To UBound(ar)
d(ar(i, 1)) = ''
Next
For i = 1 To UBound(ar)
d(ar(i, 2)) = ''
Next
n = d.Count
ReDim br(1 To n 1, 1 To n 1)
For i = 1 To n
br(i 1, 1) = d.keys()(i - 1)
br(1, i 1) = d.keys()(i - 1)
Next
For i = 1 To UBound(ar)
For ib = 1 To n 1
For jb = 1 To n 1
If ar(i, 1) & ar(i, 2) = br(ib, 1) & br(1, jb) Then br(ib, jb) = ar(i, 3): GoTo 100
Next
Next
100:
Next
Sheets(3).Cells.Clear
Sheets(3).[a1].Resize(n 1, n 1) = br
End Sub
==我是分隔线，www.vbafans.com==
方法5：
龙神：
Sub transform()
Dim conn As Object
Dim rst As Object
Dim sql As String, i As Long
Set conn = CreateObject('adodb.connection')
Set rst = CreateObject('adodb.recordset')
conn.Open 'dsn=excel files;dbq=' & ThisWorkbook.FullName
Dim sort_array
sort_array = Array('上海', '乌鲁木齐', '兰州', '北京', '南京', '南宁', '南昌', '台北', '合肥', '呼和浩特', '哈尔滨', '天津', '太原', '广州', '成都', '拉萨', '昆明', '杭州', '武汉', '沈阳', '济南', '澳门', '石家庄', '福州', '西宁', '西安', '贵阳', '郑州', '重庆', '银川', '长春', '长沙', '香港')
sql = 'transform sum([Dist (km)]) select [City 2] as ['] from '
sql = sql & ' (select * from [City Distance$] union select [City 2],[City 1],[Dist (km)] from [City Distance$] union all select a,a,0 from (select [City 1] as a from [City Distance$] union select [City 2] from [City Distance$])) u_city '
sql = sql & 'group by [City 2],instr('' & Join(sort_array, ',') & '',[City 2]) '
sql = sql & ' order by instr('' & Join(sort_array, ',') & '',[City 2])'
sql = sql & ' pivot [City 1] in (' & Join(sort_array, ',') & ')'
rst.Open sql, conn, 3, 3
With Sheets('Matrix')
.Cells.Clear
For i = 0 To rst.Fields.Count - 1
.Range('A1').Offset(0, i) = rst.Fields(i).Name
Next
.Range('A2').CopyFromRecordset rst
End With
rst.Close
Set rst = Nothing
conn.Close
Set conn = Nothing
End Sub
==我是分隔线，www.vbafans.com==
方法6：
春心：
Sub Greenhand()
Dim arr, i&, j&, k%
Set d = CreateObject('scripting.dictionary')
arr = Range(Sheets('City Distance').Cells(2, 1), Sheets('City Distance').Cells(2, 3).End(4))
For i = 1 To UBound(arr)
d(arr(i, 1)) = ''
d(arr(i, 2)) = ''
Next
Sheets('Matrix').[A2].Resize(d.Count, 1) = Application.Transpose(d.keys)
Sheets('Matrix').[B1].Resize(1, d.Count) = Application.Transpose(Application.Transpose(d.keys))
For i = 1 To UBound(arr)
For k = 2 To d.Count 1
For j = 2 To d.Count 1
If arr(i, 1) = Sheets('Matrix').Cells(k, 1) And arr(i, 2) = Sheets('Matrix').Cells(1, j) _
Or arr(i, 1) = Sheets('Matrix').Cells(1, j) And arr(i, 2) = Sheets('Matrix').Cells(k, 1) Then
Sheets('Matrix').Cells(k, j) = arr(i, 3)
End If
Next
Next
Next
End Sub
==我是分隔线，www.vbafans.com==
方法7：
随心：
Sub test() '随心
Dim brr()
Sheets('效果表1').UsedRange.ClearContents
Set d = CreateObject('scripting.dictionary')
arr = Range('a1').CurrentRegion
For j = 1 To 2
For i = 2 To UBound(arr)
d(arr(i, j)) = ''
Next
Next
n = 1: m = 1
d_1 = d.keys
For i1 = 0 To UBound(d_1)
n = n 1
ReDim Preserve brr(1 To UBound(d_1) 2, 1 To n)
brr(1, n) = d_1(i1)
For i2 = 0 To UBound(d_1)
m = m 1
brr(m, 1) = d_1(i2)
For i3 = 1 To UBound(arr)
If arr(i3, 1) = d_1(i1) And arr(i3, 2) = d_1(i2) Then
brr(m, n) = arr(i3, 3)
Exit For
ElseIf arr(i3, 1) = d_1(i2) And arr(i3, 2) = d_1(i1) Then
brr(m, n) = arr(i3, 3)
Exit For
Else
brr(m, n) = 0
End If
Next
Next
m = 1
Next
Sheets('效果表1').[a1].Resize(UBound(brr, 2), UBound(brr)) = brr
End Sub
==我是分隔线，www.vbafans.com==
方法8：
随心Python:
import pandas as pd
import collections
import xlwt
newdata=xlwt.Workbook()
sheet2=newdata.add_sheet('sheet1',cell_overwrite_ok=True)
dic_1=collections.OrderedDict()
data=pd.read_excel('E:\\test\\一维.xlsx')
#data1=data[['City 1','City 2','Dist (km)']]
for line in data.index:
dic_1[data.loc[line,'City 1']]=''
dic_1[data.loc[line,'City 2']]=''
dkey=dic_1.keys()
list_1=[]
list_2=[]
list_3=[]
n=0
m=0
for line1 in dkey:
n =1
sheet2.write(n,0,line1)
for line2 in dkey:
m =1
sheet2.write(0,m,line2)
for line in data.index:
if line1==data.loc[line,'City 1'] and line2==data.loc[line,'City 2']:
sheet2.write(n,m,str(data.loc[line,'Dist (km)']))
break
elif line1==data.loc[line,'City 2'] and line2==data.loc[line,'City 1']:
sheet2.write(n, m, str(data.loc[line, 'Dist (km)']))
break
else:
sheet2.write(n,m,0)
m=0
newdata.save('E:\\test\\结果.xls')
|
