misalnya :
prosedur A:
Sub Urut_Tic_Sek_Tgl_Kode_Harga_No()
'
Dim t As Long
Dim Data_tr As Range
Worksheets("Data Tr Saham").Select
t = Cells(Rows.Count, 1).End(xlUp).Row
'Range("A3:Z" & t).Name = "Data_tr"
Range("A3:Z3", Selection.End(xlDown)).Name = "data_tr"
'Range(Selection, Selection.End(xlDown)).Name = "Data_tr"
Range("data_tr").Select
ActiveWorkbook.Worksheets("Data Tr Saham").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Data Tr Saham").Sort.SortFields.Add _
Key:=Columns(6), SortOn:=xlSortOnValues, Order:=xlAscending,
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Data Tr Saham").Sort.SortFields.Add _
Key:=Columns(2), SortOn:=xlSortOnValues, Order:=xlAscending,
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Data Tr Saham").Sort.SortFields.Add _
Key:=Columns(4), SortOn:=xlSortOnValues, Order:=xlAscending,
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Data Tr Saham").Sort.SortFields.Add _
Key:=Columns(7), SortOn:=xlSortOnValues, Order:=xlAscending,
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Data Tr Saham").Sort.SortFields.Add _
Key:=Columns(9), SortOn:=xlSortOnValues, Order:=xlAscending,
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Data Tr Saham").Sort.SortFields.Add _
Key:=Columns(3), SortOn:=xlSortOnValues, Order:=xlAscending,
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Data Tr Saham").Sort.SortFields.Add _
Key:=Columns(7), SortOn:=xlSortOnValues, Order:=xlAscending,
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Data Tr Saham").Sort
.SetRange Range("A3:Z" & t)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A3").Select
ActiveWorkbook.Worksheets("Data Tr Saham").Sort.SortFields.Clear
End Sub
Prosedur B:
Public Sub Data_Tr_Saham_02()
Dim dbltime As Double
Dim R As Long, s As Long, t As Long
Dim Sek_ As String, No_ As String, Tic_ As String
Dim Stk_vol As Variant, Stk_val As Variant, H_Avr As Variant, R_L As
Variant
dbltime = Timer
Worksheets("Data Tr Saham").Select
Range("A1").Select
t = Cells(Rows.Count, 6).End(xlUp).Row
For R = 3 To Cells(Rows.Count, 5).End(xlUp).Row
If Cells(R, 29) <> "True" Then
Sek_ = Cells(R, 2)
No_ = Cells(R, 3)
Tic_ = Cells(R, 6)
Stk_vol = 0
Stk_val = 0
H_Avr = 0
For s = 3 To Cells(Rows.Count, 5).End(xlUp).Row
If Sek_ <> Cells(s, 2) And Tic_ <> Cells(s, 6) Then
ElseIf Sek_ = Cells(s, 2) And Tic_ = Cells(s, 6) Then
Cells(s, 29) = "True"
If Cells(s, 7) = "01-SA" Or Cells(s, 7) = "02-IPO" Or
Cells(s, 7) = "03-RI" Or Cells(s, 7) = "40-B" Or Cells(s, 7) = "41-B" _
Or Cells(s, 7) = "70-SB" Or Cells(s, 7) = "71-SS" Or
Cells(s, 7) = "72-RS" Or Cells(s, 7) = "82-TRT" Or Cells(s, 7) = "04-PS" _
Or Cells(s, 7) = "99-SK" Then
Stk_vol = Stk_vol + Cells(s, 8)
Stk_val = Cells(s, 13) + Stk_val
ElseIf Cells(s, 7) = "50-S" Or Cells(s, 7) = "51-S" Or
Cells(s, 7) = "81-TRK" Or Cells(s, 7) = "05-DS" Then
Stk_vol = Stk_vol + Cells(s, 8)
If Stk_vol = 0 Then
Stk_val = 0
H_Avr = 0
End If
ElseIf Cells(s, 7) = "60-D" Then
Stv_vol = Stk_vol
End If
H_Avr = Stk_val
Cells(s, 23) = Stk_vol
Cells(s, 24) = Stk_val
If Stk_vol <> 0 Then
Cells(s, 25) = Stk_val / Stk_vol
End If
End If
Next s
End If
Next R
Cells(1, 31) = Timer - dbltime
End Sub
Sesudah prosedur A di laksanakan di lanjutan dengan prosedur B dst nya.
Salam
Lukman
