Xin code giải bài toán lọc dữ liệu (1 người xem)

[supperkaio]

Dạ, em chào các anh chị!
Em có vấn đề này nhờ các anh chị giúp với ạ.
Em có 1 list dữ liệu công việc ngày bắt đầu và kết thúc như trong hình 1, em muốn lọc dữ liệu ra như hình 2 ở một sheet khác, thì làm ntn ạ, mong các anh chị giúp đỡ ạ, em cảm ơn nhiều

 

[huonglien1901]

Dạ, em chào các anh chị!
Em có vấn đề này nhờ các anh chị giúp với ạ.
Em có 1 list dữ liệu công việc ngày bắt đầu và kết thúc như trong hình 1, em muốn lọc dữ liệu ra như hình 2 ở một sheet khác, thì làm ntn ạ, mong các anh chị giúp đỡ ạ, em cảm ơn nhiều

Sao bạn không gửi cái file và nêu yêu cầu trong đó, bạn gửi hình ảnh như vậy làm đoán mò đoán non nữa.

 

[supperkaio]

Sao bạn không gửi cái file và nêu yêu cầu trong đó, bạn gửi hình ảnh như vậy làm đoán mò đoán non nữa.

Dạ. em up lại file đó rồi ạ. nhờ a chị giúp em với ạ

 

[PacificPR]

Dạ. em up lại file đó rồi ạ. nhờ a chị giúp em với ạ

Bạn chạy thử Code này xem sao nha

Public Sub Supperkaio()
    Dim sArr(), dArr(), I As Long, K As Long
    Dim Dic As Object, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet2
    sArr = .Range("B5", .Range("C65535").End(3)).Value
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 3)
For I = 1 To UBound(sArr, 1)
    Tem = UCase(sArr(I, 2))
    If Not Dic.Exists(Tem) Then
        K = K + 2
        Dic.Add Tem, K
        dArr(K, 1) = sArr(I, 2)
        dArr(K, 2) = sArr(I, 1)
        dArr(K, 3) = sArr(I, 1)
    Else
        If dArr(Dic.Item(Tem), 2) > sArr(I, 1) Then dArr(Dic.Item(Tem), 2) = sArr(I, 1)
        If dArr(Dic.Item(Tem), 3) < sArr(I, 1) Then dArr(Dic.Item(Tem), 3) = sArr(I, 1)
    End If
Next I
With Sheet1
    .Range("B5:D2000").ClearContents
    .Range("B5:D2000").Borders.LineStyle = xlNone
    .Range("B5").Resize(K, 3) = dArr
    .Range("B5").Resize(K, 3).Borders.LineStyle = xlContinuous
End With
Set Dic = Nothing
End Sub

 

[supperkaio]

Bạn chạy thử Code này xem sao nha

Public Sub Supperkaio()
    Dim sArr(), dArr(), I As Long, K As Long
    Dim Dic As Object, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet2
    sArr = .Range("B5", .Range("C65535").End(3)).Value
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 3)
For I = 1 To UBound(sArr, 1)
    Tem = UCase(sArr(I, 2))
    If Not Dic.Exists(Tem) Then
        K = K + 2
        Dic.Add Tem, K
        dArr(K, 1) = sArr(I, 2)
        dArr(K, 2) = sArr(I, 1)
        dArr(K, 3) = sArr(I, 1)
    Else
        If dArr(Dic.Item(Tem), 2) > sArr(I, 1) Then dArr(Dic.Item(Tem), 2) = sArr(I, 1)
        If dArr(Dic.Item(Tem), 3) < sArr(I, 1) Then dArr(Dic.Item(Tem), 3) = sArr(I, 1)
    End If
Next I
With Sheet1
    .Range("B5:D2000").ClearContents
    .Range("B5:D2000").Borders.LineStyle = xlNone
    .Range("B5").Resize(K, 3) = dArr
    .Range("B5").Resize(K, 3).Borders.LineStyle = xlContinuous
End With
Set Dic = Nothing
End Sub

sao không được bạn ơi, tạo module rồi xong copy bỏ vào f5 mà ko thấy gì cả, chỉ thấy nháy nháy thôi

 

[phulien1902]

To PacificPR:
Tuần vừa rồi người đẹp "ăn chơi" ở chốn nào mà nay tôi mới thấy xuất hiện.

 

[PacificPR]

sao không được bạn ơi, tạo module rồi xong copy bỏ vào f5 mà ko thấy gì cả, chỉ thấy nháy nháy thôi

Vậy bạn kiểm tra file này xem

 

[PacificPR]

To PacificPR:
Tuần vừa rồi người đẹp "ăn chơi" ở chốn nào mà nay tôi mới thấy xuất hiện.

Hì hì. Em đi công trình anh ạ. Hôm qua mưa to quá lên mới trốn về được mấy ngày

 

[supperkaio]

Vậy bạn kiểm tra file này xem

bạn làm ngược rồi @@ mình muốn tách ra, nghĩa là dữ liệu từ sheet 1 tách ra thành như sheet 2 đó, mình chạy thì thấy bạn tổng hợp sheet2 chạy thành sheet 1

 

[supperkaio]

Có người nói thế này mà do mình chưa biết vba lắm nên không hiểu
1. Mở vòng lặp các dòng.
2. songay = Lấy ngày cuối trừ ngày đầu, ra số dòng sẽ lặp lại để làm bước 4
3. Gán giá trị cho các dòng lặp lại với giá trị của dòng và cột B.
4. Mở vòng lặp, với số dòng ở phần 2 (songay), gán giá trị theo tăng dần bằng dòng và cột C + giá trị vòng lặp.

 

[PacificPR]

Có người nói thế này mà do mình chưa biết vba lắm nên không hiểu
1. Mở vòng lặp các dòng.
2. songay = Lấy ngày cuối trừ ngày đầu, ra số dòng sẽ lặp lại để làm bước 4
3. Gán giá trị cho các dòng lặp lại với giá trị của dòng và cột B.
4. Mở vòng lặp, với số dòng ở phần 2 (songay), gán giá trị theo tăng dần bằng dòng và cột C + giá trị vòng lặp.

Vậy bạn thử lại với Code này xem sao. Cái này giống bọn mình làm nhật ký thi công công trình thì phải

Sub Phantich()
    Dim sArr(), dArr(1 To 10000, 1 To 2), I As Long, J As Long, K As Long, Er As Long
    With Sheet1
        sArr = .Range("B5", .Range("B65535").End(3)).Resize(, 3).Value
    End With
    For I = 1 To UBound(sArr)
        If sArr(I, 1) <> Empty Then
            For J = sArr(I, 2) To sArr(I, 3)
                K = K + 1: dArr(K, 1) = J: dArr(K, 2) = sArr(I, 1)
            Next J
        End If
    Next I
    With Sheet2
        Er = .Range("B65535").End(3).Row + 1
        With .Range("B5:C" & Er)
            .ClearContents
            .Borders.LineStyle = xlNone
        End With
        If K Then
            With .Range("B5").Resize(K, 2)
                .Value = dArr
                .Borders.LineStyle = xlContinuous
                .Borders(xlInsideHorizontal).Weight = xlHairline
            End With
        End If
    End With
End Sub

 

[phulien1902]

Cảm ơn bạn PacificPR với 1 chủ đề cho 2 cách giải xuôi - ngược để tôi học tập.

 

[supperkaio]

Vậy bạn thử lại với Code này xem sao. Cái này giống bọn mình làm nhật ký thi công công trình thì phải

Sub Phantich()
    Dim sArr(), dArr(1 To 10000, 1 To 2), I As Long, J As Long, K As Long, Er As Long
    With Sheet1
        sArr = .Range("B5", .Range("B65535").End(3)).Resize(, 3).Value
    End With
    For I = 1 To UBound(sArr)
        If sArr(I, 1) <> Empty Then
            For J = sArr(I, 2) To sArr(I, 3)
                K = K + 1: dArr(K, 1) = J: dArr(K, 2) = sArr(I, 1)
            Next J
        End If
    Next I
    With Sheet2
        Er = .Range("B65535").End(3).Row + 1
        With .Range("B5:C" & Er)
            .ClearContents
            .Borders.LineStyle = xlNone
        End With
        If K Then
            With .Range("B5").Resize(K, 2)
                .Value = dArr
                .Borders.LineStyle = xlContinuous
                .Borders(xlInsideHorizontal).Weight = xlHairline
            End With
        End If
    End With
End Sub

) bạn giỏi thật đấy, đúng là nhật ký công trình rồi, mình tưởng code nó dễ dễ tí for next ngắn ngắn chi đó, định coi để áp dụng, mà nhìn cái code của bạn thế này chắc đuối. mới biết tí tẹo vba, mà nhìn cái này chưa hiểu chi, dù sao cũng cám ơn bạn nha.

 

[PacificPR]

) bạn giỏi thật đấy, đúng là nhật ký công trình rồi, mình tưởng code nó dễ dễ tí for next ngắn ngắn chi đó, định coi để áp dụng, mà nhìn cái code của bạn thế này chắc đuối. mới biết tí tẹo vba, mà nhìn cái này chưa hiểu chi, dù sao cũng cám ơn bạn nha.

Thì nó là For ... Next mà bạn. Chẳng qua thêm ít màu mè vào cho nó rối rối thôi

 

[supperkaio]

Thì nó là For ... Next mà bạn. Chẳng qua thêm ít màu mè vào cho nó rối rối thôi

chắc bạn học khóa vba ở đâu rồi chứ hè, mình cũng mới biết vba mới đây, thích vba nhưng hồi trước ko biết, giờ toàn đi ngơ ngơ công trình xa cũng ko có mạng miệc gì nên hơi nản @@

 

[PacificPR]

chắc bạn học khóa vba ở đâu rồi chứ hè, mình cũng mới biết vba mới đây, thích vba nhưng hồi trước ko biết, giờ toàn đi ngơ ngơ công trình xa cũng ko có mạng miệc gì nên hơi nản @@

Mình cũng mới đến với VBA thôi . Những cái mình biết là học ở trên GPE đó bạn
Bạn muốn học VBA 1 cách bài bản thì qua bên này đăng ký ( Mình muốn học nhưng chưa sắp xếp được thời gian) http://www.giaiphapexcel.com/diendan/threads/lớp-học-vba-online.128823/page-2#post-807923

Nếu đúng là nhật ký thi công thì phải thêm 1 cái sắp xếp theo ngày tháng và 1 đoạn loại bỏ ngày nghỉ nữa đó

 

[supperkaio]

Mình cũng mới đến với VBA thôi . Những cái mình biết là học ở trên GPE đó bạn
Nếu đúng là nhật ký thi công thì phải thêm 1 cái sắp xếp theo ngày tháng và 1 đoạn loại bỏ ngày nghỉ nữa đó

Đúng là nhật ký bạn, tại cái này mình viết tạo danh mục các công việc làm mình để ngày bắt đầu với kết thúc, nên mình tránh được các ngày nghỉ lễ, còn ngày mưa thì còn ngày nào ko làm việc thì mình để ngày mưa.
kiểu mình có cái list như thế này. nên đang coi

 

[PacificPR]

Đúng là nhật ký bạn, tại cái này mình viết tạo danh mục các công việc làm mình để ngày bắt đầu với kết thúc, nên mình tránh được các ngày nghỉ lễ, còn ngày mưa thì còn ngày nào ko làm việc thì mình để ngày mưa.
kiểu mình có cái list như thế này. nên đang coi

Thứ nhất: Bạn nên quản lý các đối tượng nghiệm thu theo mã hiệu (Như kiểu dự toán ấy). Mỗi một mã hiệu mình gán thêm cho nó TCNT, KQTN.... thì khi bạn đưa vào BBNT sẽ dễ dàng hơn
Thứ 2. Về phần nhật ký. Bạn thêm 1 Sheet thống kê ngày nghỉ thi công dựa vào đó để tùy chỉnh nhật ký và kiểm tra nhập liệu bên Sheet s("Data")
Thứ 3: Trong Sheets("Data") Bạn nhập luôn theo kiểu ngày/tháng/ năm bỏ phần ngày tháng năm của (Bắt đầu, kết thúc, BBNT ) cho gọn. Nếu trộn văn bản thì viết 1 Sub tách ra file mới

 

[supperkaio]

Thứ nhất: Bạn nên quản lý các đối tượng nghiệm thu theo mã hiệu (Như kiểu dự toán ấy). Mỗi một mã hiệu mình gán thêm cho nó TCNT, KQTN.... thì khi bạn đưa vào BBNT sẽ dễ dàng hơn
Thứ 2. Về phần nhật ký. Bạn thêm 1 Sheet thống kê ngày nghỉ thi công dựa vào đó để tùy chỉnh nhật ký và kiểm tra nhập liệu bên Sheet s("Data")
Thứ 3: Trong Sheets("Data") Bạn nhập luôn theo kiểu ngày/tháng/ năm bỏ phần ngày tháng năm của (Bắt đầu, kết thúc, BBNT ) cho gọn. Nếu trộn văn bản thì viết 1 Sub tách ra file mới

uh mình cũng muốn học mà chưa có sắp xếp dc time,
bạn nói mấy vấn đề đó đúng lắm, nhưng mình còn gà mờ quá, chưa biết làm để ngồi vọc vẹc được tí nào không đã