Phần mềm ôn thi sát hạch chứng chỉ hành nghề xây dựng

Tiêu đề: [Nhờ sửa giúp] VBA trong excel list hồ sơ hoàn công [In trang]

Tác giả: xhxd Thời gian: 31/12/2022 10:45
Tiêu đề: [Nhờ sửa giúp] VBA trong excel list hồ sơ hoàn công
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

Tác giả: tranhoe Thời gian: 31/12/2022 12:48
1./ Đã sửa tiêu đề giúp Bạn. Lần sau: bài sẽ bị Xóa theo nội quy, ở đây
2./ Đưa file lên mới sửa được. Không mua Trâu vẽ Bóng.

Chào mừng ghé thăm Phần mềm ôn thi sát hạch chứng chỉ hành nghề xây dựng (https://xaydung360.vn/diendan/)