[已解决]求excel表中自定义数据列位置的代码

18086891

学号	姓名	语文	数学	英语	地理	历史	物理	化学
0144206	王五	80	90	81	70	88	68	91
0144201	张三	60	85	86	82	78	78	82
0144202	李四	80	78	82	91	90	95	96
0144203	赵钱	88	95	78	87	93	91	96
0144204	王凡	72	91	88	64	91	85	93
0144205	史进	84	85	91	82	85	92	90
0144207	马良	69	96	90	91	99	79	86

用VBA代码自定义按首行“学号、姓名、语文等重新定义数据列的位置。

姓名	学号	语文	数学	英语	物理	化学	地理	历史
王五	0144206	80	90	81	68	91	70	88
张三	0144201	60	85	86	78	82	82	78
李四	0144202	80	78	82	95	96	91	90
赵钱	0144203	88	95	78	91	96	87	93
王凡	0144204	72	91	88	85	93	64	91
史进	0144205	84	85	91	92	90	82	85
马良	0144207	69	96	90	79	86	91	99

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2021-12-21 20:02

好像自定义排序也很方便。

1. Sub test()
   
2. With Sheets(1).Sort
   
3.   .SortFields.Clear
   
4.   .SortFields.Add Key:=Sheets(1).[a1:i1], CustomOrder:="姓名,学号,语文,数学,英语,物理,化学,地理,历史"
   
5.   .SetRange Sheets(1).[a1].CurrentRegion
   
6.   .Orientation = xlLeftToRight
   
7.   .Apply
   
8. End With
   
9. End Sub

复制代码

跳转到最佳答案楼层

wanao2008

关于你的这个问题，我做了个视频教程，发布在B站：
https://www.bilibili.com/video/BV1434y167kY?share_source=copy_web

使用到的代码如下，希望能够帮助到你！
Sub byWanao()
    Dim Dic As Object, arr, i%, j%
   
    Set Dic = CreateObject("Scripting.Dictionary")
    arr = Sheet1.UsedRange
    For j = 1 To UBound(arr, 2)
        Dic(arr(1, j)) = j
    Next
   
    For i = 2 To UBound(arr)
        For j = 1 To UBound(arr, 2)
            Sheet2.Cells(i, j) = arr(i, Dic(Sheet2.Cells(1, j).Value))
        Next
    Next
    Stop
End Sub

Sub byWanao2()
    Dim Dic As Object, i%, j%
    Set Dic = CreateObject("Scripting.Dictionary")
    For j = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
        Dic(Cells(1, j).Value) = j
    Next
    For i = 2 To Cells(1, 1).End(xlDown).Row
        For j = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
            Cells(i + 12, j) = Cells(i, Dic(Cells(13, j).Value))
        Next
    Next
End Sub

大灰狼1976

好像自定义排序也很方便。

1. Sub test()
   
2. With Sheets(1).Sort
   
3.   .SortFields.Clear
   
4.   .SortFields.Add Key:=Sheets(1).[a1:i1], CustomOrder:="姓名,学号,语文,数学,英语,物理,化学,地理,历史"
   
5.   .SetRange Sheets(1).[a1].CurrentRegion
   
6.   .Orientation = xlLeftToRight
   
7.   .Apply
   
8. End With
   
9. End Sub

复制代码

18086891

多谢各位的帮忙 。学习了