quyenpv
Thu nhặt kiến thức
- Tham gia
- 5/1/13
- Bài viết
- 725
- Được thích
- 97
- Giới tính
- Nam
- Nghề nghiệp
- Decode cuộc đời!
Em đang làm file bù nhiên liệu ca máy, tuy nhiên đang bị lỗi phần code Vlookup trong file đính kèm. Mong các cao nhân sửa giúp
Mục đích lấy đơn vị nhiên liệu của ca máy để tính hệ số phụ hao phí
Mục đích lấy đơn vị nhiên liệu của ca máy để tính hệ số phụ hao phí
Mã:
Sub BuNhienLieu_MayTC()
Sheets("BuNhienLieu").Select
Application.ScreenUpdating = False
Dim Dic As Object, Tem As String
Dim sArr(), dArr(), tArr()
Dim i As Long, j As Long, n As Long, k As Long, LaMa As Long, Stt As Long, r As Long
Dim Ma As String, eRw As Long, Id As Long, Ic As Long
Dim RngVL As Range, RngMay As Range
Set Dic = CreateObject("scripting.Dictionary")
With Sheets("VL-NC-M")
Set RngMay = .Range("B7", .Range("B65535").End(3)).Resize(, 9)
End With
With Sheets("PTVT")
'Mang
sArr = .Range("C6:C" & .Range("D65535").End(xlUp).Row).Resize(, 9).Value
tArr = .[N5:P5].Value 'Ma VL, NC, MTC
End With
LastRow = Sheets("BuNhienLieu").Cells(Rows.Count, "D").End(xlUp).Row
ReDim dArr(1 To UBound(sArr, 1), 1 To 13)
With Sheets("BuNhienLieu")
With .Range("A7:K5000")
.ClearContents
.Interior.ColorIndex = 0
.Borders.LineStyle = 0
.Font.Bold = False
End With
'For n = 1 To 3
For i = 1 To UBound(sArr, 1)
If sArr(i, 3) = Empty And sArr(i, 2) <> Empty Then Ma = sArr(i, 2)
If Ma = tArr(1, 3) Then
If sArr(i, 3) <> Empty Then
If sArr(i, 6) <> Empty Then 'Kiem tra Tong HP
Tem = sArr(i, 1) + 2
If Not Dic.Exists(Tem) Then
k = k + 1: Stt = Stt + 1
Dic.Add Tem, k
dArr(k, 1) = Stt 'STT
dArr(k, 2) = sArr(i, 1) 'Ma VT-NC-MTC
dArr(k, 3) = sArr(i, 2) 'Ten Vat tu, Nhan cong, May TC
dArr(k, 4) = sArr(i, 3) 'DVT
dArr(k, 5) = sArr(i, 6) 'Khoi luong
If Ma = tArr(1, 3) Then 'MAY THI CONG
dArr(k, 6) = "=VLOOKUP(B" & k + 6 & ",TH_VLieu,8,0)"
'dArr(k, 7) = "=VLOOKUP(B" & k + 6 & ",TH_VLieu,9,0)"
'On Error Resume Next
dArr(k, 7) = Application.VLookup(B7, RngMay, 9, False)
If Right(dArr(k, 7), 1) = "l" Then
dArr(k, 8) = 1.01
ElseIf Right(dArr(k, 7), 1) = "h" Then
dArr(k, 8) = 1
Else
dArr(k, 8) = 1.02
End If
dArr(k, 9) = "=INT(RC[-4]*RC[-3]*RC[-1])"
End If
Else
r = Dic.Item(Tem)
dArr(r, 5) = dArr(r, 5) + sArr(i, 4)
End If
End If
End If
End If
Next i
' Next n
.Range("A7").Resize(k, 13) = dArr
.Range("A7").Resize(k, 13).Borders.LineStyle = 1
End With
'Dat vung in
ActiveSheet.PageSetup.PrintArea = "$A$" & 1 & ":$M$" & Ic + 3
Set Dic = Nothing
End Sub
