Code Tách, nối chuỗi và tính tổng

lengoc1490

Thành viên mới
Tham gia ngày
21 Tháng tám 2014
Bài viết
5
Thích
0
Tuổi
28
#1
Em chào các thầy và anh/ chị!
Em có một bài toán mà nghĩ mãi không ra cách làm mong các thầy, anh/ chị giúp đỡ, viết em 1 code VBA để giải quyết bài toán.
Bảng nguồn gồm cột Mã, Chiều rộng, Số lượng. Em muốn lọc giá trị duy nhất theo chiều rộng. Đồng thời cộng tổng số lượng, và nối chuỗi mã hiệu cho ra kết quả như bảng đích.
Cảm ơn các thầy và anh/ chị nhiều!
Em xin gửi file đính kèm.
 

File đính kèm

Tham gia ngày
6 Tháng một 2011
Bài viết
7,112
Thích
7,492
#2
Em chào các thầy và anh/ chị!
Em có một bài toán mà nghĩ mãi không ra cách làm mong các thầy, anh/ chị giúp đỡ, viết em 1 code VBA để giải quyết bài toán.
Bảng nguồn gồm cột Mã, Chiều rộng, Số lượng. Em muốn lọc giá trị duy nhất theo chiều rộng. Đồng thời cộng tổng số lượng, và nối chuỗi mã hiệu cho ra kết quả như bảng đích.
Cảm ơn các thầy và anh/ chị nhiều!
Em xin gửi file đính kèm.
Gửi cái thật lên đây coi... Làm bài trên xong rồi lại hỏi thêm (à nhưng mà còn...)
 

excel_lv1.5

Thành viên thường trực
Tham gia ngày
20 Tháng mười 2017
Bài viết
314
Thích
449
#3
Em chào các thầy và anh/ chị!
Em có một bài toán mà nghĩ mãi không ra cách làm mong các thầy, anh/ chị giúp đỡ, viết em 1 code VBA để giải quyết bài toán.
Bảng nguồn gồm cột Mã, Chiều rộng, Số lượng. Em muốn lọc giá trị duy nhất theo chiều rộng. Đồng thời cộng tổng số lượng, và nối chuỗi mã hiệu cho ra kết quả như bảng đích.
Cảm ơn các thầy và anh/ chị nhiều!
Em xin gửi file đính kèm.
Bạn chạy code này xem:
PHP:
Sub pivot()
Dim i As Long, dic As Object, item, arr
arr = Range("a4:c" & [a100000].End(xlUp).Row)
Set dic = CreateObject("scripting.dictionary")
For i = 1 To UBound(arr)
    If Not dic.exists(arr(i, 2)) Then
        dic.Add arr(i, 2), Array(arr(i, 1), arr(i, 3))
    Else
        item = dic.item(arr(i, 2))
        If Not item(0) Like "*" & Right(arr(i, 1), 2) & "*" Then item(0) = item(0) & "," & Right(arr(i, 1), 2)
        item(1) = item(1) + arr(i, 3)
        dic.item(arr(i, 2)) = item
    End If
Next i
For i = 0 To dic.Count - 1
     [h4].Offset(i) = dic.keys()(i): [g4].Offset(i) = dic.items()(i)(0): [i4].Offset(i) = dic.items()(i)(1)
Next i
End Sub
 

lengoc1490

Thành viên mới
Tham gia ngày
21 Tháng tám 2014
Bài viết
5
Thích
0
Tuổi
28
#4
Bạn chạy code này xem:
PHP:
Sub pivot()
Dim i As Long, dic As Object, item, arr
arr = Range("a4:c" & [a100000].End(xlUp).Row)
Set dic = CreateObject("scripting.dictionary")
For i = 1 To UBound(arr)
    If Not dic.exists(arr(i, 2)) Then
        dic.Add arr(i, 2), Array(arr(i, 1), arr(i, 3))
    Else
        item = dic.item(arr(i, 2))
        If Not item(0) Like "*" & Right(arr(i, 1), 2) & "*" Then item(0) = item(0) & "," & Right(arr(i, 1), 2)
        item(1) = item(1) + arr(i, 3)
        dic.item(arr(i, 2)) = item
    End If
Next i
For i = 0 To dic.Count - 1
     [h4].Offset(i) = dic.keys()(i): [g4].Offset(i) = dic.items()(i)(0): [i4].Offset(i) = dic.items()(i)(1)
Next i
End Sub
Cảm ơn bác rất nhiều. Code của bác chạy rất tốt.
Em đang tập tành về mảng, có bài này làm chưa được. Bác xem giúp e với.
Trong file, sheets dữ liệu nguồn là sheets("b"). sheet chứa điều kiện cần lọc là sheets("data").
E muốn sheets("c") lấy dữ liệu từ sheets("b") khi có dữ liệu nằm trong sheets("data"). Ngược lại thì cho kết quả khác điều kiện vào sheets("a").
Bài toán lấy dữ liệu trùng dữ liệu trong data thì e làm được, còn bài toán dữ liệu không nằm trong data thì e làm không ra kết quả.
Cảm ơn bác rất nhiều!
 

File đính kèm

excel_lv1.5

Thành viên thường trực
Tham gia ngày
20 Tháng mười 2017
Bài viết
314
Thích
449
#5
Cảm ơn bác rất nhiều. Code của bác chạy rất tốt.
Em đang tập tành về mảng, có bài này làm chưa được. Bác xem giúp e với.
Trong file, sheets dữ liệu nguồn là sheets("b"). sheet chứa điều kiện cần lọc là sheets("data").
E muốn sheets("c") lấy dữ liệu từ sheets("b") khi có dữ liệu nằm trong sheets("data"). Ngược lại thì cho kết quả khác điều kiện vào sheets("a").
Bài toán lấy dữ liệu trùng dữ liệu trong data thì e làm được, còn bài toán dữ liệu không nằm trong data thì e làm không ra kết quả.
Cảm ơn bác rất nhiều!
Bạn chạy code này:
PHP:
Sub Filter()
Application.ScreenUpdating = False
Dim i As Long, na As Long, nc As Long, rng As Range, cell As Range, arr, arra, arrc
arr = Sheets("b").Range("a3:b" & Sheets("b").[a100000].End(xlUp).Row)
Set rng = Sheets("data").Range("b3:c" & Sheets("data").[b100000].End(xlUp).Row)
ReDim arrc(1 To UBound(arr), 1 To 2), arra(1 To UBound(arr), 1 To 2)
For i = 1 To UBound(arr)
    Set cell = rng.Find(arr(i, 1), LookIn:=xlValues, lookat:=xlWhole)
    If Not cell Is Nothing Then
        nc = nc + 1: arrc(nc, 1) = arr(i, 1): arrc(nc, 2) = arr(i, 2)
    Else
        na = na + 1: arra(na, 1) = arr(i, 1): arra(na, 2) = arr(i, 2)
    End If
Next i
sheetisexists "a"
Sheets("a").[a2].Resize(na, 2) = arra
sheetisexists "c"
Sheets("c").[a2].Resize(nc, 2) = arrc
Application.ScreenUpdating = True
End Sub
Function sheetisexists(namesheet As String)
Dim wb As Workbook, ws As Worksheet
Set wb = ThisWorkbook
For Each ws In wb.Worksheets
    If ws.Name = namesheet Then Exit Function
Next
Sheets.Add before:=Sheets(1)
Sheets(1).Name = namesheet
End Function
 
Lần chỉnh sửa cuối:
Top