Hãy đăng nhập để có nhiều chức năng hữu dụng hơn và xem ảnh rõ hơn!
Bạn phải đăng nhập để xem được nội dung, nếu bạn chưa có tài khoản? hãy Đăng ký mới
x
Mình thêm cột trong Excel, Giờ VBA trong excel, nhờ mọi người sửa giúp với sheet NK_2
Sub INNK_Days()
Dim dArr As Variant, sArr As Variant, tArr As Variant, Arr As Variant, S As Variant
Dim i As Long, k As Long, n As Long, sR As Long, l As Long
Dim fDay
Application.ScreenUpdating = False
With Sheets("DMCV")
dArr = .Range("E2:AG" & .Range("E65500").End(xlUp).Row).Value2
End With
With Sheets("DMVL")
sArr = .Range("D2:AG" & .Range("E65500").End(xlUp).Row).Value2
End With
With Sheets("NK_2")
fDay = Sheets("NK_2").Range("B1").Value2 ' ngay bat dau
i = Range("B3").Value2 - fDay + 1
If i < 1 Then MsgBox ("Xem lai ngay bat dau va ngay ket thuc"): Exit Sub
ReDim tArr(1 To i, 1 To 5) 'mang ghi nhan cac ngay và thu tu dong du lieu can lay
'ngay bat dau ghi vào dòng 1 cua tArr
End With
For i = 1 To UBound(dArr)
'ghi nhan dòng "ten cong viec", só 24 = thu tu cot AB - thu tu cot E +1
If Len(dArr(i, 24)) And Len(dArr(i, 25)) Then
For n = dArr(i, 24) To dArr(i, 25)
k = n - fDay + 1
tArr(k, 2) = tArr(k, 2) & "," & i
Next n
End If
'ghi nhan dòng "nhiem thu", só 19 = thu tu cot W - thu tu cot E +1
If Len(dArr(i, 19)) Then
k = dArr(i, 19) - fDay + 1
tArr(k, 3) = tArr(k, 3) & "," & i
End If
'ghi nhan dòng "lay mau TN", só 5 = thu tu cot I - thu tu cot E +1
If Len(dArr(i, 5)) Then
k = dArr(i, 5) - fDay + 1
tArr(k, 4) = tArr(k, 4) & "," & i
End If
Next i
For i = 1 To UBound(sArr)
'ghi nhan dòng "lay mau VL", só 8 = thu tu cot K - thu tu cot D +1
If Len(sArr(i, 8)) Then
k = sArr(i, 8) - fDay + 1
tArr(k, 5) = tArr(k, 5) & "," & i
End If
Next i
ReDim Arr(1 To 65000, 1 To 7)
sR = 1
For i = 1 To UBound(tArr)
If Len(tArr(i, 2)) + Len(tArr(i, 3)) + Len(tArr(i, 4)) + Len(tArr(i, 5)) Then 'neu có du lieu
Arr(sR, 1) = fDay + i - 1 'ngay có du lieu
For n = 2 To 4
If Len(tArr(i, n)) Then
k = 0
S = Split(tArr(i, n), ",")
Arr(sR, 2) = Sheets("DMCV").Range("C" & S(1) + 1).Value 'hang muc
' lay cac cot: "ten cong viec", "nhiem thu", "lay mau TN", "gio nghiem thu"
For j = 1 To UBound(S)
If n = 3 Then Arr(sR + k, 7) = dArr(S(j), 21) 'gio nghiem thu, só 21 = thu tu cot Y - thu tu cot E +1
Arr(sR + k, n + 1) = dArr(S(j), 1)
k = k + 1
Next j
End If
If tmp < sR + k Then tmp = sR + k
Next n
If Len(tArr(i, 5)) Then ' lay cot "lay mau VL"
k = 0
S = Split(tArr(i, 5), ",")
For j = 1 To UBound(S)
Arr(sR + k, 6) = sArr(S(j), 1)
k = k + 1 ' dem so dong tung ngay, cua tung cot
Next j
End If
If tmp < sR + k Then tmp = sR + k ' thu tu dong cuoi cua tung ngay
If sR + 1 = tmp Then sR = tmp + 1 Else sR = tmp ' dieu chinh thu tu dong cuoi cua tung ngay, de cot ngay co it nhat 1 dong trong
End If
Next i
With Sheets("NK_2")
.Range("A6:G50000").ClearContents
.Range("A6:G6").Resize(sR) = Arr
End With
Application.ScreenUpdating = True
End Sub
Sub Spinner_Change()
Dim dArr As Variant, sArr As Variant
Dim i As Long, k1 As Byte, k2 As Byte, k3 As Byte, k4 As Byte, k5 As Byte
Dim R1 As Byte, R2 As Byte, R3 As Byte, R4 As Byte, R5 As Byte
Dim ngay
Application.ScreenUpdating = False
R1 = 16: R2 = 44: R3 = 63: R4 = 82: R5 = 103
ngay = Range("B5").Value2
Rows("16:122").EntireRow.Hidden = False
Union(Range("A16:A42"), Range("A44:A61"), Range("A63:A80"), Range("A82:A101"), Range("A103:A122")).ClearContents
With Sheets("DMCV")
dArr = .Range("E2:AG" & .Range("E65500").End(xlUp).Row).Value2
End With
With Sheets("DMVL")
sArr = .Range("D2:AG" & .Range("E65500").End(xlUp).Row).Value2
End With
For i = 1 To UBound(dArr)
If Len(dArr(i, 24)) And Len(dArr(i, 25)) Then
If dArr(i, 24) <= ngay And dArr(i, 25) >= ngay Then
Cells(R1 + k1, 1) = dArr(i, 1)
k1 = k1 + 1
End If
End If
If dArr(i, 19) = ngay Then
Cells(R2 + k2, 1) = dArr(i, 1)
k2 = k2 + 1
End If
If dArr(i, 5) = ngay Then
Cells(R3 + k3, 1) = dArr(i, 1)
k3 = k3 + 1
End If
Next i
If k1 + R1 <= 42 Then Rows(k1 + R1 & ":39").EntireRow.Hidden = True
If k2 + R2 <= 61 Then Rows(k2 + R2 & ":58").EntireRow.Hidden = True
If k3 + R3 <= 80 Then Rows(k3 + R3 & ":77").EntireRow.Hidden = True
For i = 1 To UBound(sArr)
If sArr(i, 8) = ngay Then
Cells(R4 + k4, 1) = sArr(i, 1)
k4 = k4 + 1
End If
If sArr(i, 20) = ngay Then
Cells(R5 + k5, 1) = sArr(i, 1)
k5 = k5 + 1
End If
Next i
If k4 + R4 <= 101 Then Rows(k4 + R4 & ":98").EntireRow.Hidden = True
If k5 + R5 <= 122 Then Rows(k5 + R5 & ":119").EntireRow.Hidden = True
Application.ScreenUpdating = True
End Sub
|