Tình hình là em có 1 bảng exel tổng, giờ muốn coppy sang 1 file exel theo form có nhiều điều kiện kèm theo mà rắc rối quá chắc phải xài vba, anh chị nào rành xử lý dùm em với, trong file cái nào làm được em đã làm rồi, còn những cái chưa làm được em gửi các anh chị xem giúp dùm với ạ, e cảm ơn anh chị!
Nhờ các anh chị xử lý bảng exel theo coppy theo form và có định dạng (1 người xem)
- Thread starter romkut3
- Ngày gửi
Người dùng đang xem chủ đề này
mình đã xem rồi và trúng ý mình, nhưng vừa rồi mình có thay đổi số cột và cố chỉnh lại trong code của bạn nhưng vẫn k đc, vì k hiểu lắm... mình đã nêu trong file đính kèm, bạn xem và giúp dùm mình với nhé, thank bạn nhiều nhiều
Lần chỉnh sửa cuối:
Upvote
0
chucuoi92
Thành viên lười biếng
- Tham gia
- 11/9/09
- Bài viết
- 850
- Được thích
- 488
- Giới tính
- Nam
- Nghề nghiệp
- Chăn trâu
Ấy ấy thêm nhiều sheet hỏi quá!
Mình là thành viên lười biếng mà.
Sửa lại code cho đúng với thứ tự cột đã thay đổi thôi nhé!
còn các sheet khác (trích lọc, tổng hợp) thì để người khác giúp nhé!
Trong file bạn có hỏi
Mình đưa ảnh lên để bạn hiểu:
Upvote
0
Thaks bạn quan tâm rất nhiều, bạn có thể làm giúp mình 1 cái pl16 thôi đc k? Do cái đó mình nghĩ chỉ vba làm đc chứ công thức chắc k đc... còn mấy cái khác mình sẻ cố làm thử... rất mong đc sự quan tâm của bạn
Upvote
0
ok bạn mình chờ được
Upvote
0
chucuoi92
Thành viên lười biếng
- Tham gia
- 11/9/09
- Bài viết
- 850
- Được thích
- 488
- Giới tính
- Nam
- Nghề nghiệp
- Chăn trâu
Như đã hứa với bạnok bạn mình chờ được
PHP:
Sub PL16()
Dim d As Object
Dim data, tam
Dim i As Long, k As Long, j As Long
Dim sothua As String, ma As String
Set d = CreateObject("scripting.Dictionary")
data = Sheet1.Range("A2:R" & Sheet1.Range("A65536").End(xlUp).Row)
ReDim tam(1 To UBound(data), 1 To 7)
d.CompareMode = vbTextCompare
For i = 1 To UBound(data)
ma = data(i, 2) & data(i, 14)
If sothua <> data(i, 14) Then
d.RemoveAll
k = k + 1
sothua = data(i, 14)
tam(k, 1) = k
tam(k, 2) = data(i, 14)
If Not d.exists(ma) Then
d.Add ma, ""
tam(k, 4) = tam(k, 4) + 1
Else
End If
tam(k, 3) = tam(k, 3) + 1
tam(k, 5) = tam(k, 5) + IIf(data(i, 13) <> 1, 1, 0)
tam(k, 6) = tam(k, 6) + data(i, 6)
Else
If Not d.exists(ma) Then
d.Add ma, ""
tam(k, 4) = tam(k, 4) + 1
End If
tam(k, 3) = tam(k, 3) + 1
tam(k, 5) = tam(k, 5) + IIf(data(i, 13) <> 1, 1, 0)
tam(k, 6) = tam(k, 6) + data(i, 6)
End If
Next
For j = 1 To k
tam(k + 1, 1) = "Tông"
tam(k + 1, 2) = tam(k + 1, 2) + 1
tam(k + 1, 3) = tam(k + 1, 3) + tam(j, 3)
tam(k + 1, 4) = tam(k + 1, 4) + tam(j, 4)
tam(k + 1, 5) = tam(k + 1, 5) + tam(j, 5)
tam(k + 1, 6) = tam(k + 1, 6) + tam(j, 6)
Next
Range("A7").Resize(10000, 7).Clear
Range("A7").Resize(k + 1, 7) = tam
Range("A7").Resize(k + 1, 7).Borders.ColorIndex = 1
End Sub
Upvote
0
Thans bạn, mình k coá laptop tí mình ol test. Thử.
Upvote
0
CODE ĐÓ ĐÚNG RỒI. bạn chỉnh dùm mình cột tổng số chủ quản lý chỉ tính cho mã lớn hơn 1 và lọc trùng số chủ quản lý đó, ví dụ tờ 1 có 3 chủ qunar lý 11 và 1 quản lý là 6 thì tính là 2, bỏ các chủ quản lý là 1( gDC),... thank bạn. chỗ cái code <> 1,1,0 mình thử điều chỉnh nó vẫn k ra và k có cái code lọc trùng nên k đúng như mong muốn...
Upvote
0
chucuoi92
Thành viên lười biếng
- Tham gia
- 11/9/09
- Bài viết
- 850
- Được thích
- 488
- Giới tính
- Nam
- Nghề nghiệp
- Chăn trâu
Mấy ngày rồi, không nhớ mình làm thế nào nữa, xem mãi mới nhớ lại đôi chút
Sửa thế này không biết có đúng không.
PHP:
Sub PL16()
Dim d As Object, d2 As Object
Dim data, tam
Dim i As Long, k As Long, j As Long
Dim sothua As String, ma As String
Set d = CreateObject("scripting.Dictionary")
Set d2 = CreateObject("scripting.Dictionary")
data = Sheet1.Range("A2:R" & Sheet1.Range("A65536").End(xlUp).Row)
ReDim tam(1 To UBound(data), 1 To 7)
d.CompareMode = vbTextCompare
For i = 1 To UBound(data)
ma = data(i, 2) & data(i, 14)
If sothua <> data(i, 14) Then
d.RemoveAll
d2.RemoveAll
k = k + 1
sothua = data(i, 14)
tam(k, 1) = k
tam(k, 2) = data(i, 14)
tam(k, 3) = tam(k, 3) + 1
tam(k, 6) = tam(k, 6) + data(i, 6)
If data(i, 13) <> 1 Then
If Not d2.exists(data(i, 13)) Then
d2.Add data(i, 13), ""
tam(k, 5) = tam(k, 5) + 1
End If
End If
If Not d.exists(ma) Then
d.Add ma, ""
tam(k, 4) = tam(k, 4) + 1
End If
Else
If data(i, 13) <> 1 Then
If Not d2.exists(data(i, 13)) Then
d2.Add data(i, 13), ""
tam(k, 5) = tam(k, 5) + 1
End If
End If
If Not d.exists(ma) Then
d.Add ma, ""
tam(k, 4) = tam(k, 4) + 1
End If
tam(k, 3) = tam(k, 3) + 1
tam(k, 6) = tam(k, 6) + data(i, 6)
End If
Next
For j = 1 To k
tam(k + 1, 1) = Sheet5.[n4]
tam(k + 1, 2) = tam(k + 1, 2) + 1
tam(k + 1, 3) = tam(k + 1, 3) + tam(j, 3)
tam(k + 1, 4) = tam(k + 1, 4) + tam(j, 4)
tam(k + 1, 5) = tam(k + 1, 5) + tam(j, 5)
tam(k + 1, 6) = tam(k + 1, 6) + tam(j, 6)
Next
Range("A7").Resize(10000, 7).Clear
Range("A7").Resize(k + 1, 7) = tam
Range("A7").Resize(k + 1, 7).Borders.ColorIndex = 1
End Sub
Upvote
0
bạn thật vi dịu.. đúng rầu thank bạn nhiều nhé
Upvote
0
Bài viết mới nhất
- Question
- Question
- Question
