【已解决，感谢baofa2】用VBA进行排序：一个sheet中很多个表，每个表单独排序

flb_2001

baofa2 发表于 2024-4-28 10:25

还有要说明的是：V1代表的是供应商名称，不是第一个，排序和参与单位数一样，并不是将字段名排序，是字段名对应下面的内容排序

david_jiao

flb_2001 发表于 2024-4-28 10:24
公司没发上传附件，加密的

你这样提问题老师们没法帮你，你按照你们公司的表格做一个附件上传，各位老师才好帮你写代码！

baofa2

1. Sub test1() '无模拟附件 不再参与了 一改就乱 一审就烦
   
2.   Dim ar, wks As Worksheet
   
3.   Dim i As Long, j As Long, colSize As Long, posRow As Long
   
4.   
   
5.   Application.ScreenUpdating = False
   
6.   
   
7.   Set wks = ActiveSheet
   
8.   ar = wks.Range("A1").CurrentRegion
   
9.   posRow = UBound(ar) + 1
   
10.   colSize = UBound(ar, 2)
    
11.   
    
12.   For i = UBound(ar) To 1 Step -1
    
13.     If ar(i, 1) = "品名" Then
    
14.       With wks
    
15.         With .Sort
    
16.           With .SortFields
    
17.             .Clear
    
18.             .Add Key:=wks.Cells(i, 2), SortOn:=0, Order:=1, DataOption:=0
    
19.             For j = 3 To UBound(ar, 2)
    
20.               If Len(ar(i, j)) Then
    
21.                 .Add Key:=wks.Cells(i, j), SortOn:=0, Order:=2, DataOption:=0
    
22.               End If
    
23.             Next
    
24.             .Parent.SetRange wks.Cells(i, 1).Resize(posRow - i, colSize)
    
25.             .Parent.Header = xlYes
    
26.             .Parent.Apply
    
27.             .Clear
    
28.           End With
    
29.         End With
    
30.       End With
    
31.       posRow = i
    
32.     End If
    
33.   Next
    
34.   
    
35.   Set wks = Nothing
    
36.   Application.ScreenUpdating = True
    
37.   Beep
    
38. End Sub

复制代码

flb_2001

baofa2 发表于 2024-4-28 15:39

知道了，公司把office文件加密，上传不上来，再次感谢！