Option Explicit
Dim rowcount As Long, myrng As Range, i As Integer, lookupval As String, lookuprng As Range
Dim totalrng As Range, rownum As Variant
Sub sortData()
rowcount = ThisWorkbook.Sheets(1).Range("D2").End(xlDown).Row
Set myrng = ThisWorkbook.Sheets(1).Range("D1:D" & rowcount)
i = 1
For i = 1 To rowcount - 1
lookupval = Format(Application.WorksheetFunction.Large(myrng, i), "#.00")
With ThisWorkbook.Sheets(1).Range(myrng.Address)
If InStr(lookupval, ".") > 1 Then
Set lookuprng = .Find(what:=lookupval, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)
ElseIf (InStr(lookupval, ".")) = 1 Then
Set lookuprng = .Find(what:=lookupval, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows)
End If
End With
ThisWorkbook.Sheets(1).Range("K" & (i + 1)) = lookupval
ThisWorkbook.Sheets(1).Range("H" & (i + 1)) = lookuprng.Offset(0, -3)
ThisWorkbook.Sheets(1).Range("I" & (i + 1)) = lookuprng.Offset(0, -2)
ThisWorkbook.Sheets(1).Range("J" & (i + 1)) = lookuprng.Offset(0, -1)
Set lookuprng = Nothing
lookupval = vbNullString
Next
End Sub
Dim rowcount As Long, myrng As Range, i As Integer, lookupval As String, lookuprng As Range
Dim totalrng As Range, rownum As Variant
Sub sortData()
rowcount = ThisWorkbook.Sheets(1).Range("D2").End(xlDown).Row
Set myrng = ThisWorkbook.Sheets(1).Range("D1:D" & rowcount)
i = 1
For i = 1 To rowcount - 1
lookupval = Format(Application.WorksheetFunction.Large(myrng, i), "#.00")
With ThisWorkbook.Sheets(1).Range(myrng.Address)
If InStr(lookupval, ".") > 1 Then
Set lookuprng = .Find(what:=lookupval, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)
ElseIf (InStr(lookupval, ".")) = 1 Then
Set lookuprng = .Find(what:=lookupval, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows)
End If
End With
ThisWorkbook.Sheets(1).Range("K" & (i + 1)) = lookupval
ThisWorkbook.Sheets(1).Range("H" & (i + 1)) = lookuprng.Offset(0, -3)
ThisWorkbook.Sheets(1).Range("I" & (i + 1)) = lookuprng.Offset(0, -2)
ThisWorkbook.Sheets(1).Range("J" & (i + 1)) = lookuprng.Offset(0, -1)
Set lookuprng = Nothing
lookupval = vbNullString
Next
End Sub
No comments:
Post a Comment