Đăng ký học Excel, VBA và phân tích số liệu cùng GPE tháng 1/2018 - TPHCM

Mua sách "VBA trong Excel - Cải thiện và tăng tốc" tái bản

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

Thảo luận trong 'Khu vực đăng bài chung' bắt đầu bởi lengoc1490, 12 Tháng một 2018.

  1. lengoc1490

    lengoc1490 Thành viên mới

    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.
     

    Các file đính kèm:

    • Vidu.xlsx
      Kích thước:
      10.8 KB
      Đọc:
      6
  2. befaint

    befaint |||||||||||||

    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...)
     
    lengoc1490 thích bài này.
  3. excel_lv1.5

    excel_lv1.5 Thành viên thường trực

    Bạn chạy code này xem:
    PHP:
    Sub pivot()
    Dim i As Longdic As Objectitemarr
    arr 
    Range("a4:c" & [a100000].End(xlUp).Row)
    Set dic CreateObject("scripting.dictionary")
    For 
    1 To UBound(arr)
        If 
    Not dic.exists(arr(i2)) Then
            dic
    .Add arr(i2), Array(arr(i1), arr(i3))
        Else
            
    item dic.item(arr(i2))
            If 
    Not item(0Like "*" Right(arr(i1), 2) & "*" Then item(0) = item(0) & "," Right(arr(i1), 2)
            
    item(1) = item(1) + arr(i3)
            
    dic.item(arr(i2)) = item
        End 
    If
    Next i
    For 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ích bài này.
  4. lengoc1490

    lengoc1490 Thành viên mới

    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!
     

    Các file đính kèm:

  5. excel_lv1.5

    excel_lv1.5 Thành viên thường trực

    Bạn chạy code này:
    PHP:
    Sub Filter()
    Application.ScreenUpdating False
    Dim i 
    As Longna As Longnc As Longrng As Rangecell As Rangearrarraarrc
    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 
    1 To UBound(arr)
        
    Set cell rng.Find(arr(i1), LookIn:=xlValueslookat:=xlWhole)
        If 
    Not cell Is Nothing Then
            nc 
    nc 1arrc(nc1) = arr(i1): arrc(nc2) = arr(i2)
        Else
            
    na na 1arra(na1) = arr(i1): arra(na2) = arr(i2)
        
    End If
    Next i
    sheetisexists 
    "a"
    Sheets("a").[a2].Resize(na2) = arra
    sheetisexists 
    "c"
    Sheets("c").[a2].Resize(nc2) = arrc
    Application
    .ScreenUpdating True
    End Sub
    Function sheetisexists(namesheet As String)
    Dim wb As Workbookws 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: 13 Tháng một 2018 lúc 09:29
    lengoc1490 thích bài này.

Chia sẻ trang này