Nhờ các anh chị giúp em chỉnh sổ này thành sổ có cột tk đối ứng (1 người xem)
- Thread starter sktinsect
- Ngày gửi
-
- Thẻ
- excel 2024 xử lý nkc
Người dùng đang xem chủ đề này
A có thể gửi em file này hoặc hướng dẫn dùng cái query để clean ko ạ. E cảm ơn anh.
Oki a, e cảm ơn a nhé
Với dữ liệu nầy dùng query không khả thi !
Dùng code VBA cũng khá mệt mỏi. Code chỉ dùng theo dữ liệu được sắp xếp như trong file, bạn kiểm tra lại cẩn thận.
Mã:
Option Explicit
Sub NKC()
Dim arr(), res(), ct$, no&, co&, col&, tkNo$, tkCo$, tkdu$, du&, c&
Dim sRow&, i&, k&, r&, fr&, rKH&, stN#, st#, t#
With Sheets("Sheet1")
arr = Range("A8:M" & Range("G" & Rows.Count).End(xlUp).Row + 1).Value
End With
sRow = UBound(arr) - 1
ReDim res(1 To sRow, 1 To 11)
For i = 1 To sRow
If ct <> arr(i, 2) & "|" & arr(i, 3) Then
ct = arr(i, 2) & "|" & arr(i, 3)
fr = i: rKH = 0
no = 0: co = 0
End If
If arr(i, 4) <> Empty Then rKH = i
If ct <> arr(i + 1, 2) & "|" & arr(i + 1, 3) Then
For r = fr To i - 1 '1 No _ 1 Co
If arr(r, 10) <> 0 Then
If arr(r, 10) = arr(r + 1, 11) Then '1 No _ 1 Co
res(r, 7) = arr(r, 7): res(r, 8) = arr(r + 1, 7): res(r, 9) = arr(r, 10)
res(r, 1) = arr(r, 1): res(r, 2) = arr(r, 2)
res(r, 3) = arr(r, 3): res(r, 6) = arr(r, 6)
res(r, 10) = arr(r, 12): res(r, 11) = arr(r, 13)
If rKH > 0 Then
res(r, 4) = arr(rKH, 4): res(r, 5) = arr(rKH, 5)
End If
arr(r, 10) = 0: arr(r + 1, 11) = 0
r = r + 1
Else
no = no + 1
tkNo = arr(r, 7)
End If
ElseIf arr(r, 11) <> 0 Then
If arr(r, 11) = arr(r + 1, 10) Then '1 Co _ 1 No
res(r, 7) = arr(r + 1, 7): res(r, 8) = arr(r, 7): res(r, 9) = arr(r, 11)
res(r, 1) = arr(r, 1): res(r, 2) = arr(r, 2)
res(r, 3) = arr(r, 3): res(r, 6) = arr(r, 6)
res(r, 10) = arr(r, 12): res(r, 11) = arr(r, 13)
If rKH > 0 Then
res(r, 4) = arr(rKH, 4): res(r, 5) = arr(rKH, 5)
End If
arr(r, 11) = 0: arr(r + 1, 10) = 0
r = r + 1
Else
co = co + 1
tkCo = arr(r, 7)
End If
End If
Next r
If r = i Then
If arr(r, 10) <> 0 Then no = no + 1 Else co = co + 1
End If
If no > 0 And co > 0 Then 'n NO _ n Co
st = 0
For r = fr To i
If t = 0 Then
If arr(r, 10) <> 0 Then '1 No _ n Co
tkdu = arr(r, 7): t = arr(r, 10)
col = 11: du = 7: c = 8
ElseIf arr(r, 11) <> 0 Then 'n No _ 1 Co
tkdu = arr(r, 7): t = arr(r, 11)
col = 10: du = 8: c = 7
End If
Else
If arr(r, col) <> 0 Then
res(r, du) = tkdu: res(r, c) = arr(r, 7): res(r, 9) = arr(r, col)
res(r, 1) = arr(r, 1): res(r, 2) = arr(r, 2)
res(r, 3) = arr(r, 3): res(r, 4) = arr(r, 4)
res(r, 5) = arr(r, 5): res(r, 6) = arr(r, 6)
res(r, 10) = arr(r, 12): res(r, 11) = arr(r, 13)
t = t - res(r, 9)
End If
End If
Next r
End If
End If
Next i
Sheets("Sheet1").Range("O8").Resize(sRow, 11) = res
End SubE cảm ơn a. A cho e hỏi chút đây là code VBA đúng ko a nhỉ? Nếu mình tự học VBA thì phải bắt đầu từ đâu và có nguồn nào để tự học ko a?
Bạn hỏi ban quản trị diễn đàn xem có còn mở lớp VBA không và liên hệ mua sách học VBA
87kilua
Thành viên hoạt động
- Tham gia
- 19/11/21
- Bài viết
- 180
- Được thích
- 108
