我有一个案例将值复制并粘贴到新列并删除重复项并按前 3 个大值排序。
这是我的 table :
这是我当前要复制到新列的代码:
Columns("I:J").EntireColumn.Delete
LRow = sht.Range("A" & Rows.Count).End(xlUp).Row
.Range("A1:A" & LRow).Copy: .Range("I1").PasteSpecial xlPasteValues
.Range("C1:C" & LRow).Copy: .Range("J1").PasteSpecial xlPasteValues
.Range("I:J", .Range("I:J").End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlNo
但此代码仅复制并删除列 A 和 C 中的重复项,并复制到列 J 和 K。
这是我想要的结果,当复制和删除重复项时,我只想显示此图片中的前 3 个大值(列 J 和 K)并添加新列
Rank
显示排名值:最佳答案
此代码可用于您的目的:
Sub GetRank()
Dim mySheet As Worksheet
Set mySheet = Sheets("Sheet1") 'Ubah Nama Sheet Sesuai Aktual
'In this sample, only until row 12, can be changed with last row
mySheet.Range("J1:K12").ClearContents
mySheet.Range("A1:A12,C1:C12").Copy mySheet.Range("J1")
mySheet.Range("I1").Value = "Rank"
mySheet.Range("I2").Value = "1"
mySheet.Range("I3").Value = "2"
mySheet.Range("I4").Value = "3"
mySheet.Range("J2:K12").RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo
mySheet.Sort.SortFields.Clear
mySheet.Sort.SortFields.Add Key:=Range("K2:K12") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
mySheet.Sort.SortFields.Add Key:=Range("J2:J12") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With mySheet.Sort
.SetRange Range("J1:K12")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
mySheet.Range("J5:K12").ClearContents
End Sub
关于excel - 宏复制和粘贴并按前 3 个值(或更多)排序,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/60180433/