Xin chào các anh/chị trong diễn đàn, em có file đính kèm cùng bên dưới, trong đó có sheet result1 và result2, ví dụ em nhập dữ liệu vào phần input (gõ lần lượt từng ô) của sheet result2, sẽ hiện ra kết quả tìm kiếm như trong file, sau đó em muốn tổng hợp dữ liệu đó theo thứ tự ngày vào sheet "conclu" ạ. Mong anh/chị trợ giúp!
Hỗ trợ tổng hợp dữ liệu kết quả tìm kiếm theo ngày
- Thread starter domjnjc
- Ngày gửi
Chạy sub
Mã:
Sub ABC()
Dim sh As Worksheet, sArr(), Res()
Dim dk, dk2, sRow&, i&, j&, k&, S
Dim chk As Boolean, chk2 As Boolean
With Sheets("result2")
dk = .Range("A2").Value: dk2 = .Range("B2").Value
If dk = Empty Or dk2 = Empty Then Exit Sub
End With
ReDim Res(1 To 10000, 1 To 6)
For Each sh In ActiveWorkbook.Worksheets
If IsNumeric(sh.Name) Then
i = sh.Range("E60000").End(xlUp).Row
If i >= 2 Then
sArr = sh.Range("A2:E" & i).Value
sRow = UBound(sArr)
For i = 1 To sRow
If sArr(i, 2) = dk Then
If sArr(i, 4) = dk2 Then
k = k + 1
For j = 1 To 5
Res(k, j) = sArr(i, j)
Next j
S = Split(sArr(i, 1), "/")
Res(k, 6) = DateValue("2000/" & S(1) & "/" & S(0))
End If
End If
Next i
End If
End If
Next sh
Application.EnableEvents = False
Application.ScreenUpdating = False
With Sheets("conclu")
i = .Range("D" & Rows.Count).End(xlUp).Row
If i > 1 Then .Range("D2:H" & i).ClearContents
If k Then
.Range("D2").Resize(k).NumberFormat = "@"
.Range("D2").Resize(k, 6) = Res
.Range("D2").Resize(k, 6).Sort .Range("I2"), xlAscending, Header:=xlNo
.Range("I2").Resize(k).ClearContents
End If
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Upvote
0
tks a, em chạy sub được rồi ạ!
Upvote
0
Có 1 vấn đề phát sinh như sau ạ: khi em tìm kiếm a1,c1: kết quả hiện có thể có cả trường hợp có ngày chứa c1,a1, khi đó sub chỉ cập nhật theo thứ tự tìm kiếm a1,c1 chứ không chứa ngày có c1,a1 ạ
Upvote
0
Bạn gởi file với ví dụ minh họa
Upvote
0
Ví dụ: nhập tìm kiếm a3, c3 vào phần input của result2, ta được kết quả như file đính kèm, (tồn tại ngày 11/5 chứa c3 và a3). Khi em chạy sub thì kết quả thu được thiếu ngày 11/5 với kết quả c3,a3 ạ
Upvote
0
ý bạn chỉ cần giống điều kiện không cần đúng cột
Mã:
Sub Button1_Click()
Dim sh As Worksheet, sArr(), Res()
Dim dk, dk2, sRow&, i&, j&, t&, t2&, k&, S
Dim chk As Boolean, chk2 As Boolean
With Sheets("result2")
dk = .Range("A2").Value: dk2 = .Range("B2").Value
If dk = Empty Or dk2 = Empty Then Exit Sub
If dk = dk2 Then Exit Sub
End With
ReDim Res(1 To 10000, 1 To 6)
For Each sh In ActiveWorkbook.Worksheets
If IsNumeric(sh.Name) Then
i = sh.Range("E60000").End(xlUp).Row
If i >= 2 Then
sArr = sh.Range("A2:E" & i).Value
sRow = UBound(sArr)
For i = 1 To sRow
t = 0: t2 = 0
For j = 2 To 5
If sArr(i, j) = dk Then t = 1
If sArr(i, j) = dk2 Then t2 = 1
Next j
If t + t2 = 2 Then
k = k + 1
For j = 1 To 5
Res(k, j) = sArr(i, j)
Next j
S = Split(sArr(i, 1), "/")
Res(k, 6) = DateValue("2000/" & S(1) & "/" & S(0))
End If
Next i
End If
End If
Next sh
Application.EnableEvents = False
Application.ScreenUpdating = False
With Sheets("conclu")
i = .Range("D" & Rows.Count).End(xlUp).Row
If i > 1 Then .Range("D2:H" & i).ClearContents
If k Then
.Range("D2").Resize(k).NumberFormat = "@"
.Range("D2").Resize(k, 6) = Res
.Range("D2").Resize(k, 6).Sort .Range("I2"), xlAscending, Header:=xlNo
.Range("I2").Resize(k).ClearContents
End If
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Upvote
0
Tks anh, bao quát điều kiện r ạ!
Upvote
0
a giúp em tạo thêm 1 button tổng hợp tương tự với kết quả tìm được ở sheet result1 với ạ, e mày mò mà không có ra ạ@@!
Lần chỉnh sửa cuối:
Upvote
0
kết quả giống y như sheet result1 hay khác
Upvote
0
E gõ giá trị tìm kiếm vào ô c2 của sheet result1>>> ra kết quả, e muốn tạo button tổng hợp kết quả đó theo ngày như đối với sheet result2 ạ
Upvote
0
Ý mình muốn biết trình bày kết quả ở sheet result1 như thế nào?
Upvote
0
tổng hợp kết quả của result1 vào giống như ở sheet conclu ạ
Upvote
0
Chạy code
Mã:
Sub Result1()
Dim sh As Worksheet, sArr(), Res()
Dim dk, sRow&, i&, j&, t&, k&, S
Dim chk As Boolean, chk2 As Boolean
With Sheets("result1")
dk = .Range("C2").Value
If dk = Empty Then Exit Sub
End With
ReDim Res(1 To 10000, 1 To 6)
For Each sh In ActiveWorkbook.Worksheets
If IsNumeric(sh.Name) Then
i = sh.Range("E60000").End(xlUp).Row
If i >= 2 Then
sArr = sh.Range("A2:E" & i).Value
sRow = UBound(sArr)
For i = 1 To sRow
For j = 2 To 5
If sArr(i, j) = dk Then
k = k + 1
For c = 1 To 5
Res(k, c) = sArr(i, c)
Next c
S = Split(sArr(i, 1), "/")
Res(k, 6) = DateValue("2000/" & S(1) & "/" & S(0))
Exit For
End If
Next j
Next i
End If
End If
Next sh
Application.EnableEvents = False
Application.ScreenUpdating = False
With Sheets("result1")
i = .Range("AE" & Rows.Count).End(xlUp).Row
If i > 1 Then .Range("AE2:AJ" & i).ClearContents
If k Then
.Range("AE2").Resize(k).NumberFormat = "@"
.Range("AE2").Resize(k, 6) = Res
.Range("AE2").Resize(k, 6).Sort .Range("AJ2"), xlAscending, Header:=xlNo
.Range("AJ2").Resize(k).ClearContents
End If
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Upvote
0
TKs a, chạy tốt ạ!
Upvote
0
Anh cho em hỏi, tại sao sau khi nhập giá trị vào ô input của sheet result1 và cho ra kết quả, ta làm thao tác xóa dữ liệu 1 ngày bất kỳ rồi chạy sub, thì vẫn cho ra được kết quả của ngày đã xóa ạ?
Upvote
0
Sub nào? gởi file ví dụ minh họa
Upvote
0
Khi em nhập vào ô c2, ra kết quả của 3 ngày, em làm thao tác xóa 1 ngày bất kỳ, rồi chạy sub "button click 3", thì vẫn cho ra kết quả có ngày đã xóa ạ
Upvote
0
"xóa 1 ngày bất kỳ" như thế nào? mình xóa kết quả sẽ mất
Upvote
0
em gửi lại file cùng ý muốn hỏi trong đó ạ.
Upvote
0
